Giga Games 1/Giga Games.iso/net/go/prog/goboard.sh

Linux/UNIX/POSIX Shell Script | 1993-06-20 | 231.8 KB | 8,478 lines

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#    MANIFEST
#    README
#    go.pas
#    goBoard.pas
#    goCom.pas
#    goMenu.pas
#    goMgr.pas
#    goPlayUtils.pas
#    goPlayer.pas
#    goTree.pas
# This archive created: Mon Jan 22 17:42:31 1990
export PATH; PATH=/bin:/usr/bin:$PATH
if test -f 'MANIFEST'
then
    echo shar: "will not over-write existing file 'MANIFEST'"
else
cat << \SHAR_EOF > 'MANIFEST'
   File Name        Archive #    Description
-----------------------------------------------------------
 MANIFEST                  1    This shipping list
 README                    1
 go.pas                    4
 goBoard.pas               3
 goCom.pas                 1
 goMenu.pas                5
 goMgr.pas                 4
 goPlayUtils.pas           1
 goPlayer.pas              2
 goTree.pas                3
SHAR_EOF
fi
if test -f 'README'
then
    echo shar: "will not over-write existing file 'README'"
else
cat << \SHAR_EOF > 'README'
This go board manager and rudimentary go player was written by
Stoney Ballard at Perq Systems in 1983-1984.  It is written in
Perq Pascal and utilizes some Perq libraries for I/O.  The code
is offered here if someone is interested to convert it to Unix.

The wonderful part about it is that a game is recorded as a tree
and can be played forward or backward, branching at any point
where there were alternate moves.

For some time, this program was also used to generate the go
boards displayed in the American Go Journal.  For this it used
some large font digits which are now lost.

Fred Hansen
SHAR_EOF
fi
if test -f 'go.pas'
then
    echo shar: "will not over-write existing file 'go.pas'"
else
cat << \SHAR_EOF > 'go.pas'
{---------------------------------------------------------------}
{ Go Game Manager                                               }
{ Copyright (c) 1982 by Three Rivers Computer Corp.             }
{                                                               }
{ Written: June 3, 1982 by Stoney Ballard                       }
{ Edit History:                                                 }
{    June  3, 1982 Started                                      }
{    June  4, 1982 Add dead group removal                       }
{    June 10, 1982 Use new go file manager                      }
{    Nov  10, 1982 Extensively Hacked Up                        }
{    Dec  29, 1982 Changed "Erase Branch" to "Prune Branches"   }
{    Jan   6, 1983 Added ^C escape from all readlns             }
{---------------------------------------------------------------}

program Go;

exports

imports stream from stream;

procedure resetInput;

private

imports system from System;
imports raster from raster;
imports screen from screen;
imports popUp from popUp;
imports IO_Others from IO_Others;
imports goCom from goCom;
imports goMgr from goMgr;
imports goTree from goTree;
imports goBoard from goBoard;
imports goMenu from goMenu;
imports memory from memory;
imports perq_string from perq_string;
imports goPlayer from goPlayer;

label
  99;       (* the fatal error point *)

var
  oCurPosX, oCurPosY: integer;
  oScreenPtr: rasterPtr;

  procedure resetInput;
  begin { resetInput }
    streamKeyboardReset(input);
  end { resetInput };

  procedure newTitle;
  var
    ts: string[128];
    fn: string;
    fl, fPos, tPos, i: integer;
  begin { newTitle }
    ts := 'Go  Version ';
    ts := concat(ts, version);
    getFNameString(fn);
    fl := length(fn);
    if fl > 0 then
      begin
        fPos := 81 - fl;
        tPos := length(ts) + 1;
        adjust(ts, 80);
        for i := tPos to 80 do
          ts[i] := ' ';
        for i := fPos to fPos + fl - 1 do
          ts[i] := fn[i - fPos + 1];
      end;
    changeTitle(ts);
  end { newTitle };

  procedure initialize;
  var
    sseg: integer;

    procedure setupWindows;
    var
      ts: string;
    begin { setupWindows }
      createWindow(boardWin, bWinX, bWinY, bWinW, bWinH, ' ');
      createWindow(menuWin, mWinX, mWinY, mWinW, mWinH, '');
      createWindow(statWin, sWinX, sWinY, sWinW, sWinH, '');
      changeWindow(0);
      gameFName := '';
      newTitle;
    end { setupWindows };

  begin { initialize }
    createSegment(sseg, 192, 1, 192);
    oScreenPtr := makePtr(sseg, 0, rasterPtr);
    SReadCursor(oCurPosX, oCurPosY);
    rasterop(rRpl, 768, 1024, 0, 0, SScreenW, oScreenPtr,
                              0, 0, SScreenW, SScreenP);
    IOSetFunction(CTCursCompl);
    rasterop(RAndNot, 768, 1024, 0, 0, SScreenW, SScreenP,
                                 0, 0, SScreenW, SScreenP);
    setupWindows;
    initMenu;
    captures[black] := 0;
    captures[white] := 0;
    initGoTree;
    initGoBoard;
    makeGoTree;
    initGoMgr;
    gameFName := '';
    numbEnabled := false;
    treeDirty := false;
    playLevel := 0;
    debug := false;
    printLarge := true;
    initGoPlayer;
  end { initialize };

  procedure doit;
  var
    done, foundIt, endLoop, gbg: boolean;
    CtlCseen, playMyself, lastWasPass: boolean;
    whoseTurn, whoWasLast: sType;
    i, xi, yi, xs, ys: integer;
    numDead, numHC, cmd: integer;
    lastBuM: integer;
    thisTag: tagPtr;
    lastMove: pMRec;

    function getLine(var l: string): boolean;
    label
      1;
    var
      i, j, cx, cy: integer;

      handler ctlC;
      begin { ctlC }
        IOKeyClear;
        streamKeyboardReset(input);
        beep(error);
        prompt('');
        l := '';
        getLine := false;
        exit(getLine);
      end { ctlC };

      handler pastEOF(fn: pathName);
      begin { pastEOF }
        reset(input, fn);
        sSetCursor(cx, cy);
        write('    ');
        sSetCursor(cx, cy);
        goto 1;
      end { pastEOF };

    begin { getLine }
      sReadCursor(cx, cy);
    1:
      readln(l);
      getLine := true;
      j := 0;
      for i := 1 to length(l) do
        if ord(l[i]) >= 32 then
          begin
            j := j + 1;
            l[j] := l[i];
          end;
      adjust(l, j);
    end { getLine };

    procedure resetGame;
    begin { resetGame }
      clearBoard;
      koX := -1;
      koY := -1;
      moveNum := 0;
      curMove := treeRoot;
      captures[black] := 0;
      captures[white] := 0;
      showCaptures;
      whoseTurn := black;
      turnIs(black);
      gameFname := '';
      newTitle;
      gameOver := false;
      initGoMgr;
    end { resetGame };

    procedure switchWho;
    begin { switchWho }
      if curMove = treeRoot then
        whoseTurn := black
      else if curMove^.id = remove then
        whoseTurn := curMove^.who
      else if curMove^.id = hcPlay then
        whoseTurn := white
      else if curMove^.who = black then
        whoseTurn := white
      else
        whoseTurn := black;
      turnIs(whoseTurn);
    end { switchWho };

    procedure updateStatus;
    begin { updateStatus }
      dotLast;
      showCaptures;
      showComment;
      showTag;
      switchWho;
    end { updateStatus };

    procedure doReadGame;
    var
      fName: pathName;

      handler badFileVersion;
      begin { badFileVersion }
        beep(error);
        prompt('');
        write(gameFName, ' is not compatable with this version of GO');
        resetGame;
        exit(doReadGame);
      end { badFileVersion };

    begin { doReadGame }
      if menuGoFile(fName) then
        begin
          prompt('Reading ');
          write(fName, '.Go ...');
          readTree(concat(fName, '.GO'));
          resetGame;
          gameFName := fName;
          if treeRoot^.lastMove <> nil then
            switchBranch(treeRoot^.lastMove);
          treeDirty := false;
          prompt('');
          newTitle;
        end;
    end { doReadGame };

    procedure doWriteGame;
    var
      fs: string;
      procedure addExt(var nam: string);
      var
        es: string;
      begin { addExt }
        if length(nam) > 3 then
          begin
            es := substr(nam, length(nam) - 2, 3);
            convUpper(es);
            if es <> '.GO' then
              nam := concat(nam, '.Go');
          end
        else
          nam := concat(nam, '.Go');
      end { addExt };

      handler badGoWrite;
      begin { badGoWrite };
        beep(error);
        prompt('Unable to write file ');
        write(fs);
        exit(doWriteGame);
      end { badGoWrite };

    begin { doWriteGame }
      IOKeyClear;
      streamKeyboardReset(input);
      if gameFName <> '' then
        begin
          prompt('Game File Name [');
          write(gameFName, ']? ');
        end
      else
        prompt('Game File Name? ');
      if not getLine(fs) then
        exit(doWriteGame);
      if fs = '' then
        if gameFName = '' then
          begin
            beep(error);
            prompt('');
            exit(doWriteGame);
          end
        else
          fs := gameFName;
      gameFName := fs;
      addExt(fs);
      prompt('Writing ');
      write(fs, ' ...');
      writeTree(fs, curMove);
      treeDirty := false;
      prompt('');
      newTitle;
    end { doWriteGame };

    function chooseAlt: boolean;
    label
      10;
    var
      bx, by, xs, ys: integer;
      tm: pMRec;
      hc0There: boolean;
      hcMenu: pNameDesc;
      res: resres;
      numHC, i, j, numNHC: integer;

      handler outside;
      begin { outside }
        destroyNameDesc(hcMenu);
        chooseAlt := false;
        beep(error);
        restoreCursor;
        exit(chooseAlt);
      end { outside };

    begin { chooseAlt }
      chooseAlt := false;
      switchWho;
      waitNoButton;
      tm := curMove^.flink;
      numHC := 0;
      numNHC := 0;
      hc0There := false;
      while tm <> nil do
        begin
          if tm^.id = hcPlay then
            numHC := numHC + 1
          else
            begin
              hc0There := true;
              numNHC := numNHC + 1;
            end;
          tm := tm^.slink;
        end;
      if numHC > 0 then
        begin
          if hc0There then
            numHC := numHC + 1;
          allocNameDesc(numHC, 0, hcMenu);
          hcMenu^.header := 'Handicap Alternates';
          j := 1;
          if hc0There then
            begin
              hcMenu^.commands[1] := '0';
              j := 2;
            end;
          tm := curMove^.flink;
          for i := j to numHC do
            begin
              while tm^.id <> hcPlay do
                tm := tm^.slink;
    {$R-}
              hcMenu^.commands[i] := ' ';
              hcMenu^.commands[i][1] := chr(tm^.hcNum + ord('0'));
    {$R=}
              tm := tm^.slink;
            end;
          menu(hcMenu, false, 1, numHC, -1, -1, -1, res);
          restoreCursor;
          destroyNameDesc(hcMenu);
          i := res^.indices[1];
          destroyRes(res);
          if hc0There then
            if i = 1 then
              begin
                if numNHC > 1 then
                  goto 10;
                tm := curMove^.flink;
                while tm^.id <> move do
                  tm := tm^.slink;
                forwardTo(tm);
                chooseAlt := true;
                exit(chooseAlt);
              end
            else
              i := i - 1;
          tm := curMove^.flink;
          j := 0;
          repeat
            while tm^.id <> hcPlay do
              tm := tm^.slink;
            j := j + 1;
            if j <> i then
              tm := tm^.slink;
          until j = i;
          forwardTo(tm);
          chooseAlt := true;
        end
      else
        begin
  10:
          showAlts;
          waitButton;
          if passLocCur(tabRelX, tabRelY) then
            begin
              if passIsAlt then
                begin
                  selPass;
                  chooseAlt := true;
                  waitNoButton;
                  exit(chooseAlt);
                end;
            end
          else if bLocCur(tabRelX, tabRelY, bx, by, xs, ys) then
            if board[bx][by].val = alternate then
              begin
                selAlt(bx, by);
                chooseAlt := true;
                waitNoButton;
                exit(chooseAlt);
              end;
          remAlts;
          beep(error);
        end;
      waitNoButton;
    end { chooseAlt };

    procedure mForward;
    var
      gbg: boolean;
    begin { mForward }
      if gameOver then
        restoreDead;
      if atLeaf(curMove) then
        beep(error)
      else if atBranch(curMove) then
        gbg := chooseAlt
      else
        forwardTo(curMove^.flink);
    end { mForward };

    procedure doBkToS;
    var
      bx, by, sx, sy: integer;
    begin { doBkToS }
      prompt('Point at stone to backup to');
      waitButton;
      if bLocCur(tabRelX, tabRelY, bx, by, xs, ys) then
        if board[bx][by].val <> empty then
          begin
            while not lastPlayAt(bx, by) do
              backup1;
            exit(doBkToS);
          end;
      beep(error);
      waitNoButton;
    end { doBkToS };

    procedure doPutTag;
    var
      ts: tagStr;
      cm: pMRec;
    begin { doPutTag }
      if curMove = treeRoot then
        beep(error)
      else
        begin
          IOKeyClear;
          streamKeyboardReset(input);
          prompt('Tag String: ');
          if not getLine(ts) then
            exit(doPutTag);
          if length(ts) > maxTagLen then
            begin
              beep(error);
              prompt('Tags may be no longer than ');
              write(maxTagLen:0, ' characters');
            end
          else if length(ts) = 0 then
            begin
              if curMove^.tag = nil then
                begin
                  beep(error);
                  prompt('');
                end
              else
                begin
                  delTag(curMove^.tag);
                  prompt('Tag Deleted');
                end;
            end
          else if tagExists(ts) then
            begin
              beep(error);
              prompt('That tag already exists');
            end
          else
            begin
              tagMove(curMove, ts);
            end;
        end;
    end { doPutTag };

    procedure doGoToTag;
    var
      thisTag: tagPtr;
    begin { doGoToTag }
      thisTag := getTagMenu;
      if thisTag <> nil then
        switchBranch(thisTag^.mPtr);
    end { doGoToTag };

    procedure doPutCmt;
    var
      cs, curCmt: string;
    begin { doPutCmt }
      IOKeyClear;
      streamKeyboardReset(input);
      prompt('Comment: ');
      if not getLine(cs) then
        exit(doPutCmt);
      if length(cs) = 0 then
        if getComment(curMove, curCmt) then
          prompt('Comment Deleted')
        else
          begin
            beep(error);
            prompt('');
          end;
      commentMove(curMove, cs);
    end { doPutCmt };

    procedure doScore;
    var
      wScore, bScore, wr, br: integer;
      done: boolean;
      bx, by, xs, ys: integer;
    begin { doScore }
      putEnd;
      done := false;
      prompt('Point at dead groups, Press outside of board to stop');
      repeat
        waitButton;
        if bLocCur(tabRelX, tabRelY, bx, by, xs, ys) then
          begin
            if board[bx, by].val <> empty then
              delGroup(bx, by);
          end
        else
          done := true;
        showCaptures;
        waitNoButton;
      until done;
      prompt('Counting Score ...');
      scoreGame(wScore, bScore);
      wScore := wScore - captures[black];
      bScore := bScore - captures[white];
      if wScore < 0 then
        begin
          wr := -wScore;
          wScore := 0;
        end
      else
        wr := 0;
      if bScore < 0 then
        begin
          br := -bScore;
          bScore := 0;
        end
      else
        br := 0;
      bScore := bScore + wr;
      wScore := wScore + br;
      prompt('Score is: ');
      write('White = ', wScore:0, ', Black = ', bScore:0);
      if wScore = bScore then
        write(' - A Tie!')
      else if wScore > bScore then
        write(' - White Wins by ', (wScore - bScore):0)
      else
        write(' - Black Wins by ', (bScore - wScore):0)
    end { doScore };

    procedure doEraseMove;
    var
      lm: pMRec;
    begin { doEraseMove }
      if gameOver then
        restoreDead;
      if curMove = treeRoot then
        beep(error)
      else
        begin
          lm := curMove;
          backup1;
          lm := delBranch(lm);
          treeDirty := true;
        end;
    end { doEraseMove };

    procedure doPruneBranches;
    var
      lm, sm, tm: pMRec;
      tp: tagPtr;
      didPrune: boolean;
    begin { doPruneBranches }
      if gameOver then
        restoreDead;
      if not isBranch(curMove) then
        beep(error)
      else if not confirmed then
        beep(error)
      else
        begin
          didPrune := false;
          wipeTreeMarks;
          lm := curMove;
          while lm <> treeRoot do
            begin
              lm^.mark := true;
              lm := lm^.blink;
            end;
          tp := treeRoot^.lastTag;
          while tp <> nil do
            begin
              lm := tp^.mPtr;
              while lm <> treeRoot do
                begin
                  lm^.mark := true;
                  lm := lm^.blink;
                end;
              tp := tp^.nextTag;
            end;
          lm := curMove;
          while lm <> treeRoot do
            begin
              if lm^.blink^.flink^.slink <> nil then
                begin
                  sm := lm^.blink^.flink;
                  while sm <> nil do
                    if not sm^.mark then
                      begin
                        tm := sm;
                        sm := sm^.slink;
                        tm := delBranch(tm);
                        didPrune := true;
                        treeDirty := true;
                      end
                    else
                      sm := sm^.slink;
                end;
              lm := lm^.blink;
            end;
          if not didPrune then
            prompt('All Branches Were Tagged');
        end;
    end { doPruneBranches };

    handler ctlC;
    begin { ctlC }
      IOKeyClear;
      CtlCseen := true;
    end { ctlC };

  begin { doit }
    resetGame;
    done := false;
    lastMove := nil;
    CtlCseen := false;
    playMyself := false;
    lastWasPass := false;
    IOSetModeTablet(relTablet);
    IOCursorMode(trackCursor);
    activate(mReadFile, true);
    activate(mTogNums, true);
    activate(mQuit, true);
    activate(mPutCmt, true);
    activate(mAutoPlay, true);
    activate(mPlayMyself, true);
    activate(mSetPlayLevel, true);
    activate(mDebug, true);
    activate(mRefBoard, true);
    activate(mShoState, true);
    activate(mBoardSize, true);
    repeat
      if curMove <> lastMove then
        checkAtari(curMove);
      updateStatus;
      lastMove := curMove;
      if not playMyself then
        begin
          activate(mPrintBoard, curMove <> treeRoot);
          activate(mPrintDiag, curMove <> treeRoot);
          activate(mStepToTag, stepTagPossible);
          activate(mSetStepTag, treeRoot^.lastTag <> nil);
          activate(mGotoTag, treeRoot^.lastTag <> nil);
          activate(mInit, treeRoot^.flink <> nil);
          activate(mWriteFile, treeRoot^.flink <> nil);
          activate(mSetHc, curMove = treeRoot);
          activate(mPass, curMove <> treeRoot);
          activate(mScore, curMove <> treeRoot);
          activate(mForToBr, hasBranch(curMove));
          activate(mBackToBr, isBranch(curMove));
          activate(mBackToStone, curMove <> treeRoot);
          activate(mForToLeaf, curMove^.flink <> nil);
          activate(mPutTag, curMove <> treeRoot);
          activate(mGotoRoot, curMove <> treeRoot);
          activate(mEraseMove, curMove <> treeRoot);
          activate(mPruneBranches, isBranch(curMove));
          activate(mBackOne, curMove <> treeRoot);
          activate(mForOne, curMove^.flink <> nil);
        end;
      if CtlCseen then
        cmd := mCtlC
      else if playMyself then
        cmd := mAutoPlay
      else
        repeat
          cmd := getMenuCmd;
        until cmd <> none;
      prompt('');
      case cmd of
        mCtlC:
          begin
            playMyself := false;
            CtlCseen := false;
          end;
        mPlaceStone:
          begin
            if gameOver then
              restoreDead;
            if bLocCur(tabRelX, tabRelY, xi, yi, xs, ys) then
              begin
                if board[xi, yi].val <> empty then
                  beep(error)
                else if (xi = koX) and (yi = koY) then
                  beep(koV)
                else
                  doMove(whoseTurn, xi, yi, xs, ys);
              end
            else
              beep(error);
            waitNoButton;
          end;
        mAutoPlay:
          begin
            if gameOver then
              restoreDead;
            prompt('Thinking...');
            if curMove = treeRoot then
              lastWasPass := false
            else
              lastWasPass := curMove^.id = pass;
            if playMove(whoseTurn, xi, yi) then
              begin
                if board[xi, yi].val <> empty then
                  begin
                    beep(error);
                    prompt('Bad move at ');
                    write((xi + 1):0, ', ', (yi + 1):0);
                    playMyself := false;
                    write(' - Generated by ', playreason);
                  end
                else if (xi = koX) and (yi = koY) then
                  begin
                    beep(koV);
                    prompt('ko violation at ');
                    write((xi + 1):0, ', ', (yi + 1):0);
                    write(' - Generated by ', playreason);
                    playMyself := false;
                  end
                else
                  begin
                    doMove(whoseTurn, xi, yi, 0, 0);
                    if board[xi, yi].val = empty then
                      begin
                        prompt('self kill at ');
                        write((xi + 1):0, ', ', (yi + 1):0);
                        write(' - Generated by ', playreason);
                        playMyself := false;
                      end
                    else
                      commentMove(curMove, playReason);
                  end;
              end
            else
              begin
                doPass(whoseTurn);
                if lastWasPass then
                  playMyself := false;
              end;
            waitNoButton;
            prompt('');
          end;
        mPlayMyself:
          playMyself := true;
        mSetPlayLevel:
          menuPlayLevel(playLevel, maxPlayLevel);
        mShoState:
          showPlayState(whoseTurn);
        mInit:
          if confirmed then
            begin
              makeGoTree;
              resetGame;
              treeDirty := false;
            end
          else
            beep(error);
        mSetHc:
          if moveNum = 0 then
            begin
              if gameOver then
                restoreDead;
              numHC := getHCMenu;
              if numHC > 0 then
                doHCPlay(numHC)
              else
                beep(error);
            end
          else
            beep(error);
        mPass:
          begin
            if gameOver then
              restoreDead;
            doPass(whoseTurn);
          end;
        mScore:
          doScore;
        mForToBr:
          begin
            if gameOver then
              restoreDead;
            if atLeaf(curMove) then
              beep(error)
            else if not atBranch(curMove) then
               forwToBr;
            if not atLeaf(curMove) then
              gbg := chooseAlt;
          end;
        mBackToBr:
          begin
            if gameOver then
              restoreDead;
            if curMove = treeRoot then
              beep(error)
            else
              backToBr;
            if atBranch(curMove) then
              gbg := chooseAlt;
          end;
        mBackToStone:
          begin
            if gameOver then
              restoreDead;
            if curMove = treeRoot then
              beep(error)
            else
              doBkToS;
          end;
        mForToLeaf:
          begin
            if gameOver then
              restoreDead;
            if atLeaf(curMove) then
              beep(error)
            else
              begin
                endLoop := false;
                repeat
                  if atLeaf(curMove) then
                    endLoop := true
                  else if atBranch(curMove) then
                    begin
                      if not chooseAlt then
                        begin
                          endLoop := true;
                          beep(error);
                        end;
                    end
                  else
                    forwToBr;
                until endLoop;
              end;
          end;
        mPutTag:
          doPutTag;
        mGotoTag:
          doGoToTag;
        mGotoRoot:
          switchBranch(treeRoot);
        mPutCmt:
          doPutCmt;
        mReadFile:
          if confirmed then
            doReadGame;
        mWriteFile:
          doWriteGame;
        mEraseMove:
          doEraseMove;
        mPruneBranches:
          doPruneBranches;
        mTogNums:
          if not numbEnabled then
            begin
              numbEnabled := true;
              showAllStones;
              dotSX := -1;
              putMString(mTogNums, 'Erase Numbers');
            end
          else
            begin
              numbEnabled := false;
              showAllStones;
              dotSX := -1;
              dotLast;
              putMString(mTogNums, 'Show Stone Numbers');
            end;
        mDebug:
          if debug then
            begin
              debug := false;
              putMString(mDebug, 'Turn Debug On');
            end
          else
            begin
              debug := true;
              putMString(mDebug, 'Turn Debug Off');
            end;
        mBoardSize:
          begin
            printLarge := not printLarge;
            if printLarge then
              begin
                prompt('Will Print on Large Board Now');
                putMString(mBoardSize, 'Use Small Board');
              end
            else
              begin
                prompt('Will Print on Small Board Now');
                putMString(mBoardSize, 'Use Large Board');
              end;
          end;
        mPrintBoard:
          printBoard(false);
        mPrintDiag:
          printBoard(true);
        mStepToTag:
          begin
            if gameOver then
              restoreDead;
            if stepTag = nil then
              stepTag := getTagMenu;
            if stepTag <> nil then
              doStepTag
            else
              beep(error);
          end;
        mSetStepTag:
          begin
            thisTag := getTagMenu;
            if thisTag <> nil then
              stepTag := thisTag;
          end;
        mQuit:
          if confirmed then
            done := true;
        mBackOne:
          begin
            if gameOver then
              restoreDead
            else if curMove = treeRoot then
              beep(error)
            else
              backUp1;
          end;
        mForOne:
          begin
            if gameOver then
              restoreDead;
            mForward;
          end;
        mRefBoard:
          refreshBoard;
      end { case };
      if not playMyself then
        endCmd;
    until done;
  end { doit };

  procedure cleanup;
  begin { cleanup }
    screenReset;
    rasterOp(rRpl, 768, 1024, 0, 0, SScreenW, SScreenP,
                              0, 0, SScreenW, oScreenPtr);
    SSetCursor(oCurPosX, oCurPosY);
  end { cleanup };

  handler ctlC;
  begin { ctlC }
    IOKeyClear;
  end { ctlC };

begin { Go }
  initialize;
  doit;
99:
  cleanUp;
end { Go }.
SHAR_EOF
fi
if test -f 'goBoard.pas'
then
    echo shar: "will not over-write existing file 'goBoard.pas'"
else
cat << \SHAR_EOF > 'goBoard.pas'
{---------------------------------------------------------------}
{ goBoard.Pas                                                   }
{                                                               }
{ Board Image Handler for Go                                    }
{ Copyright (c) 1982 by Three Rivers Computer Corp.             }
{                                                               }
{ Written: June 3, 1982 by Stoney Ballard                       }
{ Edit History:                                                 }
{    June  3, 1982 Started                                      }
{    June  4, 1982 Add dead group removal                       }
{    June 10, 1982 Use new go file manager                      }
{    Nov   8, 1982 Split From Go.Pas                            }
{---------------------------------------------------------------}


module goBoard;

exports

imports goCom from goCom;
imports screen from screen;

type
  SoundType = (atari, koV, s3, s4, die, die2, die3, error);

exception gbFatal;

procedure initGoBoard;
procedure clearBoard;
procedure addHCStones(num: integer);
procedure placeStone(which: sType; lx, ly, ofx, ofy, moveNum: integer);
procedure placeAlt(which: sType; lx, ly, ofx, ofy: integer);
procedure remStone(lx, ly: integer);
procedure showPass(which: sType);
procedure remPass;
function passLocCur(cx, cy: integer): boolean;
function bLocCur(cx, cy: integer; var lx, ly, sx, sy: integer): boolean;
procedure beep(sound: SoundType);
procedure dotStone(lx, ly: integer);
procedure showAllStones;
procedure printBoard(isDiagram: boolean);
procedure showCaptures;
procedure turnIs(who: sType);
procedure refreshBoard;
procedure putBString(x, y: integer; s: string);

private

imports raster from raster;
imports io_unit from io_unit;
imports io_others from io_others;
imports memory from memory;
imports fileSystem from fileSystem;
imports perq_string from perq_string;
imports csdx from csdx;
imports goMgr from goMgr;
imports goTree from goTree;
imports goMenu from goMenu;
imports system from system;
imports go from go;

const
  sPicC = 15;
  sPicS = 32;
  hpPicS = 10;
  hpPicC = 4;
  patchS = 40;
  patchC = 19;
  picWW = 4;
  htHeight = 4;
  htWidth = 48;
  gridWidth = 32;
  pGridWidth = 34;   { for printing }
  xMargin = boardX + gridWidth;
  yMargin = boardY + gridWidth;
  pxMargin = pBoardX + pGridWidth;
  pyMargin = pBoardY + pGridWidth;
  gridBorder = gridWidth div 2;
  pGridBorder = pGridWidth div 2;
  gridXMargin = xMargin - gridBorder;
  gridYMargin = yMargin - gridBorder;
  pGridXMargin = pxMargin - pGridBorder;
  pGridYMargin = pyMargin - pGridBorder;
  htXMargin = xMargin - gridWidth;
  htYMargin = yMargin - gridWidth;
  phtXMargin = pxMargin - pGridWidth;
  phtYMargin = pyMargin - pGridWidth;
  boardHeight = 20 * gridWidth;
  pBoardHeight = 20 * pGridWidth;
  slopSize = 2;
  lineWidth = 2;
  extraXO = pxMargin;  { 96 }
  extraYO = 768;
  pedgeBX = pxMargin;  { 96 }
  pedgeBY = pyMargin + (19 * pGridWidth);  { 672 }
  pedgeLX = pBoardX;  { 64 }
  pedgeLY = pBoardY + (19 * pGridWidth);  { 640 }
  edgeBX = xMargin;  { 96 }
  edgeBY = yMargin + (19 * GridWidth);  { 672 }
  edgeLX = BoardX;  { 64 }
  edgeLY = BoardY + (19 * GridWidth);  { 640 }
  rCmtY = pBoardX + pBoardHeight + 32;
  lCmtY = rCmtY + 8 + charHeight;
  tFntWidth = 6;
  tFntHeight = 9;
  maxSMark = 2;

type
  htArray = array[0..3] of array[0..47] of integer;
  pHtArray = ^htArray;

  beepbuf = array[0..63] of integer;
  pBeepBuf = ^BeepBuf;

var
  hcDot: pPicBuf;
  htBuf: pHtArray;
  patch: array[1..9] of pPicBuf;
  StatPtr: IOStatPtr;
  statRec: IOStatus;
  sounds: array[atari..die3] of pBeepBuf;
  stones: array[sType] of pPicBuf;
  stoneCir: pPicBuf;
  stoneMarks: array[0..maxSMark] of pPicBuf;
  sysFont: fontPtr;
  goBNumFont: fontPtr;
  goSNumFont: fontPtr;
  goTNumFont: fontPtr;
  goSLetFont: fontPtr;
  printing: boolean;
  scrSavPtr: rasterPtr;
  sNumBase, sNumStart: integer;
  bigNums: boolean;

{ merely beeps the given sound }
procedure beep(sound: SoundType);
var
  zilch: Double;
  rep, i: integer;
  savY, savB, savG, savW, savS: boolean;
begin { beep }
 if sound = error then
   IOBeep
 else
   begin
     savY := tabYellow;
     savW := tabWhite;
     savG := tabGreen;
     savB := tabBlue;
     savS := tabSwitch;
     IOSetModeTablet(offTablet);
     if sound = die then
       rep := 128 * 3
     else
       rep := 128;
     UnitIO(Speech, RECAST(sounds[sound],IOBufPtr), IOWriteHiVol, rep,
            zilch, nil, StatPtr);
     IOSetModeTablet(relTablet);
     tabYellow := savY;
     tabWhite := savW;
     tabGreen := savG;
     tabBlue := savB;
     tabSwitch := savS;
   end;
end { beep };

procedure showCaptures;
var
  s: string;

  procedure dectos(val: integer);
  var
    numC, i: integer;
    ts: string;
    c: char;
  begin { dectos }
    if val = 0 then
      s := '0'
    else
      begin
        numC := 0;
        adjust(ts, 20);
        while val <> 0 do
          begin
            numC := numC + 1;
            ts[numC] := chr(val mod 10 + ord('0'));
            val := val div 10;
          end;
        adjust(s, numC);
        for i := 1 to numC do
          s[i] := ts[numC - i + 1];
      end;
  end { dectos };

begin { showCaptures }
  dectos(captures[black]);
  SSetCursor(captNBX, captNY);
  write(s:3);
  dectos(captures[white]);
  SSetCursor(captNWX, captNY);
  write(s:3);
end { showCaptures };

procedure turnIs(who: sType);
begin { turnIs }
  SSetCursor(turnX, turnY);
  if who = white then
    write('White to Play')
  else
    write('Black to Play');
end { turnIs };

procedure putBString(x, y: integer; s: string);
var
  xp, yp, sw, i: integer;
  fnt: fontPtr;
begin { putBString }
  setFont(goSNumFont);
  fnt := goSNumFont;
  for i := 1 to length(s) do
    if (s[i] >= '0') and
       (s[i] <= '9') then
      s[i] := chr(ord(s[i]) - #46 + #200);
  xp := x * gridWidth + xMargin;
  yp := y * gridWidth + yMargin;
  sw := 0;
  for i := 1 to length(s) do
    sw := sw + fnt^.index[lAnd(ord(s[i]), #177)].width;
  xp := xp - (sw div 2);
  yp := yp + (fnt^.height div 2) + 1;
  SChrFunc(0);
  SSetCursor(xp, yp);
  write(s:0);
end { putBString };

procedure putStone(cx, cy, mNum: integer; val: bVal);
const
  widthPad = 2;
  shPad = 3;
  bhPad = 1;
var
  x, y, org: integer;
  ns: string;
  sl, d, sw, n: integer;
  cv: integer;
  fnt: fontPtr;
  heightPad: integer;
begin { putStone }
  x := cx - sPicC;
  y := cy - sPicC;
  rasterop(RAndNot, sPicS, sPicS, x, y, SScreenW, SScreenP,
                                  0, 0, picWW, stones[black]);
  rasterop(ROr, sPicS, sPicS, x, y, SScreenW, SScreenP,
                              0, 0, picWW, stones[val]);
  if numbEnabled and (mNum > 0) then
    begin
      n := mNum - sNumBase;
      if n < 0 then
        exit(putStone);
      n := n + sNumStart;
      if bigNums then
        begin
          fnt := goBNumFont;
          heightPad := bhPad;
        end
      else
        begin
          fnt := goSNumFont;
          heightPad := shPad;
        end;
      if val = black then
        if bigNums then
          begin
            if n > 9 then
              org := ord('`')
            else
              org := ord('j');
          end
        else
          begin
            if n > 99 then
              org := #24
            else
              org := #0;
          end
      else if bigNums then
        begin
          if n > 9 then
            org := ord('@')
          else
            org := ord('J');
        end
      else
        begin
          if n > 99 then
            org := #12
          else
            org := #60;
        end;
      ns := '   ';
      sl := 0;
      sw := 0;
      if n >= 100 then
        d := 100
      else if n >= 10 then
        d := 10
      else
        d := 1;
      while d > 0 do
        begin
          sl := sl + 1;
          cv := (n div d) + org;
          ns[sl] := chr(cv + #200);
          sw := sw + fnt^.index[cv].width;
          n := n mod d;
          d := d div 10;
        end;
      adjust(ns, sl);
      x := cx - (sw div 2) + widthPad;
      y := cy + (fnt^.height div 2) + heightPad;
      setFont(fnt);
      SSetCursor(x, y);
      SChrFunc(6);
      write(ns);
      setFont(sysFont);
      SChrFunc(0);
    end;
end { putStone };

procedure showStone(lx, ly: integer);
var
  x, y: integer;
begin { showStone }
  with board[lx, ly] do
    begin
      if printing then
        if printLarge then
          begin
            x := lx * pGridWidth + pxMargin;
            y := ly * pGridWidth + pyMargin;
          end
        else { small board }
          begin
            x := lx * gridWidth + xMargin;
            y := ly * gridWidth + yMargin;
          end
      else { not printing }
        begin
          x := lx * gridWidth + xMargin + xOfs;
          y := ly * gridWidth + yMargin + yOfs;
        end;
      putStone(x, y, mNum, val);
    end;
end { showStone };

procedure showAllStones;
var
  i, j: integer;
begin { showAllStones }
  for j := 0 to maxPoint do
    for i := 0 to maxPoint do
      if board[i, j].val <> empty then
        showStone(i, j);
end { showAllStones };

procedure dotStone(lx, ly: integer);
var
  x, y: integer;
begin { dotStone }
  with board[lx, ly] do
    if val <> empty then
      begin
        x := lx * gridWidth + xMargin + xOfs;
        y := ly * gridWidth + yMargin + yOfs;
        rasterop(rNot, 2, 2, x, y, SScreenW, SScreenP,
                             x, y, SScreenW, SScreenP);
      end;
end { dotStone };

function bLocCur(cx, cy: integer; var lx, ly, sx, sy: integer): boolean;
var
  xic, yic: integer;
begin { bLocCur }
  bLocCur := false;
  if printing and printLarge then
    begin
      cx := cx - pGridXMargin;
      cy := cy - pGridYMargin;
    end
  else
    begin
      cx := cx - gridXMargin;
      cy := cy - gridYMargin;
    end;
  if (cx >= 0) and (cy >= 0) then
    begin
      if printing and printLarge then
        begin
          lx := cx div pGridWidth;
          ly := cy div pGridWidth;
          xic := lx * pGridWidth + pGridBorder;
          yic := ly * pGridWidth + pGridBorder;
        end
      else
        begin
          lx := cx div gridWidth;
          ly := cy div gridWidth;
          xic := lx * gridWidth + gridBorder;
          yic := ly * gridWidth + gridBorder;
        end;
      if (lx <= maxPoint) and (ly <= maxPoint) then
        begin
          if cx < xic - slopSize then
            cx := xic - slopSize
          else if cx > xic + slopSize then
            cx := xic + slopSize;
          if cy < yic - slopSize then
            cy := yic - slopSize
          else if cy > yic + slopSize then
            cy := yic + slopSize;
          sx := cx - xic;
          sy := cy - yic;
          bLocCur := true;
        end;
     end;
end { bLocCur };

procedure showPass(which: sType);
begin { showPass }
  SSetCursor(passX, passY);
  if which = black then
    write(' Black Passes ')
  else
    write(' White Passes ');
  passShowing := true;
end { showPass };

procedure remPass;
begin { remPass }
  SSetCursor(passX, passY);
  write('               ');
  passShowing := false;
end { remPass };

function passLocCur(cx, cy: integer): boolean;
begin { passLocCur }
  passLocCur :=  (cx >= passX) and (cx < (passX + passW)) and
                 (cy <= passY) and (cy > (passY - passH));
end { passLocCur };

procedure showAlt(lx, ly: integer; sv: sType);
begin { showAlt }
  with board[lx, ly] do
    begin
      lx := lx * gridWidth + xMargin - sPicC;
      ly := ly * gridWidth + yMargin - sPicC;
      rasterop(ROr, sPicS, sPicS, lx, ly, SScreenW, SScreenP,
                                  0, 0, picWW, stoneCir);
    end;
end { showAlt };

procedure placeStone(which: sType; lx, ly, ofx, ofy, moveNum: integer);
begin { placeStone }
  if passShowing then
    remPass;
  with board[lx, ly] do
    begin
      val := which;
      xOfs := ofx;
      yOfs := ofy;
      mNum := moveNum;
      showStone(lx, ly);
    end;
end { placeStone };

procedure placeAlt(which: sType; lx, ly, ofx, ofy: integer);
begin { placeAlt }
  with board[lx, ly] do
    begin
      val := alternate;
      xOfs := 0;
      yOfs := 0;
      mNum := -1;
      showAlt(lx, ly, which);
    end;
end { placeAlt };

procedure remStone(lx, ly: integer);
var
  x, y, i, j: integer;
begin { remStone }
  with board[lx, ly] do
    if val <> empty then
      begin
        val := empty;
        if ly = 0 then
          i := 1
        else if ly = maxPoint then
          i := 7
        else i := 4;
        if lx = maxPoint then
          i := i + 2
        else if lx > 0 then
          i := i + 1;
        if printing and printLarge then
          begin
            x := (lx * pGridWidth) - patchC + pxMargin;
            y := (ly * pGridWidth) - patchC + pyMargin;
          end
        else
          begin
            x := (lx * gridWidth) - patchC + xMargin;
            y := (ly * gridWidth) - patchC + yMargin;
          end;
        rasterop(RRpl, patchS, patchS, x, y, SScreenW, SScreenP,
                                       0, 0, picWW, patch[i]);
        if ((lx = 3)  and (ly = 3))  or
           ((lx = 9)  and (ly = 3))  or
           ((lx = 15) and (ly = 3))  or
           ((lx = 3)  and (ly = 9))  or
           ((lx = 9)  and (ly = 9))  or
           ((lx = 15) and (ly = 9))  or
           ((lx = 3)  and (ly = 15)) or
           ((lx = 9)  and (ly = 15)) or
           ((lx = 15) and (ly = 15)) then
          if printing and printLarge then
            rasterop(ROr, hpPicS, hpPicS,
                     pxMargin + (pGridWidth * lx) - hpPicC,
                     pyMargin + (pGridWidth * ly) - hpPicC,
                     SScreenW, SScreenP,
                     0, 0, picWW, hcDot)
          else
            rasterop(ROr, hpPicS, hpPicS,
                     xMargin + (gridWidth * lx) - hpPicC,
                     yMargin + (gridWidth * ly) - hpPicC,
                     SScreenW, SScreenP,
                     0, 0, picWW, hcDot);
        for i := lx - 1 to lx + 1 do
          for j := ly - 1 to ly + 1 do
            if (i >= 0) and (i <= maxPoint) and
               (j >= 0) and (j <= maxPoint) then
              if (board[i, j].val = black) or
                 (board[i, j].val = white) then
                begin
                  showStone(i, j);
                  if (i = dotSX) and (j = dotSY) then
                    dotStone(i, j);
                end;
      end;
end { remStone };

procedure addHCStones(num: integer);
begin { addHCStones }
  case num of
    2:
      begin
        placeStone(black, 3, 15, 0, 0, 0);
        placeStone(black, 15, 3, 0, 0, 0);
      end;
    3:
      begin
        placeStone(black, 3, 15, 0, 0, 0);
        placeStone(black, 15, 3, 0, 0, 0);
        placeStone(black, 15, 15, 0, 0, 0);
      end;
    4:
      begin
        placeStone(black, 3, 15, 0, 0, 0);
        placeStone(black, 15, 3, 0, 0, 0);
        placeStone(black, 3, 3, 0, 0, 0);
        placeStone(black, 15, 15, 0, 0, 0);
      end;
    5:
      begin
        placeStone(black, 3, 3, 0, 0, 0);
        placeStone(black, 3, 15, 0, 0, 0);
        placeStone(black, 9, 9, 0, 0, 0);
        placeStone(black, 15, 3, 0, 0, 0);
        placeStone(black, 15, 15, 0, 0, 0);
      end;
    6:
      begin
        placeStone(black, 3, 3, 0, 0, 0);
        placeStone(black, 3, 15, 0, 0, 0);
        placeStone(black, 3, 9, 0, 0, 0);
        placeStone(black, 15, 9, 0, 0, 0);
        placeStone(black, 15, 3, 0, 0, 0);
        placeStone(black, 15, 15, 0, 0, 0);
      end;
    7:
      begin
        placeStone(black, 3, 3, 0, 0, 0);
        placeStone(black, 3, 15, 0, 0, 0);
        placeStone(black, 3, 9, 0, 0, 0);
        placeStone(black, 9, 9, 0, 0, 0);
        placeStone(black, 15, 9, 0, 0, 0);
        placeStone(black, 15, 3, 0, 0, 0);
        placeStone(black, 15, 15, 0, 0, 0);
      end;
    8:
      begin
        placeStone(black, 3, 3, 0, 0, 0);
        placeStone(black, 3, 9, 0, 0, 0);
        placeStone(black, 3, 15, 0, 0, 0);
        placeStone(black, 9, 3, 0, 0, 0);
        placeStone(black, 9, 15, 0, 0, 0);
        placeStone(black, 15, 3, 0, 0, 0);
        placeStone(black, 15, 9, 0, 0, 0);
        placeStone(black, 15, 15, 0, 0, 0);
      end;
    9:
      begin
        placeStone(black, 3, 3, 0, 0, 0);
        placeStone(black, 3, 9, 0, 0, 0);
        placeStone(black, 3, 15, 0, 0, 0);
        placeStone(black, 9, 3, 0, 0, 0);
        placeStone(black, 9, 9, 0, 0, 0);
        placeStone(black, 9, 15, 0, 0, 0);
        placeStone(black, 15, 3, 0, 0, 0);
        placeStone(black, 15, 9, 0, 0, 0);
        placeStone(black, 15, 15, 0, 0, 0);
      end;
    end;
end { addHCStones };

procedure drawBoard;
var
  i, j, c, lWidth, x, y, w: integer;
  xMarg, yMarg, gWid, eBX, eBY, eLX, eLY: integer;
begin { drawBoard }
  if printing then
    begin
      lWidth := 1;
      if printLarge then
        begin
          xMarg := pxMargin;
          yMarg := pyMargin;
          gWid := pGridWidth;
          eBX := pedgeBX;
          eBY := pedgeBY;
          eLX := pedgeLX;
          eLY := pedgeLY;
        end
      else
        begin
          xMarg := xMargin;
          yMarg := yMargin;
          gWid := gridWidth;
          eBX := edgeBX;
          eBY := edgeBY;
          eLX := edgeLX;
          eLY := edgeLY;
        end
    end
  else
    begin
      lWidth := lineWidth;
      xMarg := xMargin;
      yMarg := yMargin;
      gWid := gridWidth;
    end;
  if not printing then
    for i := (htYMargin div htHeight) to
             ((htYMargin + boardHeight) div htHeight) - 1 do
      rasterop(RRpl, bWinW - (htXMargin * 2), htHeight,
                     htXMargin, i * htHeight, SScreenW, SScreenP,
                     htXMargin, 0, htWidth, htBuf)
  else
    rasterop(rAndNot, bWinW - (phtXMargin * 2), (bWinY + bWinH) - phtYMargin,
                      phtXMargin, phtYMargin, SScreenW, SScreenP,
                      phtXMargin, phtYMargin, SScreenW, SScreenP);
  for i := 1 to maxPoint - 1 do
    rasterop(ROrNot, (maxPoint * gWid) + lWidth, lWidth,
                     xMarg, yMarg + (i * gWid), SScreenW, SScreenP,
                     xMarg, yMarg + (i * gWid), SScreenW, SScreenP);
  for i := 1 to maxPoint - 1 do
    rasterop(ROrNot, lWidth, (maxPoint * gWid) + lWidth,
                     xMarg + (i * gWid), yMarg, SScreenW, SScreenP,
                     xMarg + (i * gWid), yMarg, SScreenW, SScreenP);
  rasterop(ROrNot, (maxPoint * gWid) + lineWidth, lineWidth,
                   xMarg, yMarg, SScreenW, SScreenP,
                   xMarg, yMarg, SScreenW, SScreenP);
  rasterop(ROrNot, (maxPoint * gWid) + lineWidth, lineWidth,
                xMarg, yMarg + (maxPoint * gWid), SScreenW, SScreenP,
                xMarg, yMarg + (maxPoint * gWid), SScreenW, SScreenP);
  rasterop(ROrNot, lineWidth, (maxPoint * gWid) + lineWidth,
                   xMarg, yMarg, SScreenW, SScreenP,
                   xMarg, yMarg, SScreenW, SScreenP);
  rasterop(ROrNot, lineWidth, (maxPoint * gWid) + lineWidth,
                xMarg + (maxPoint * gWid), yMarg, SScreenW, SScreenP,
                xMarg + (maxPoint * gWid), yMarg, SScreenW, SScreenP);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 3) - hpPicC,
                yMarg + (gWid * 3) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 9) - hpPicC,
                yMarg + (gWid * 3) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 15) - hpPicC,
                yMarg + (gWid * 3) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 3) - hpPicC,
                yMarg + (gWid * 9) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 9) - hpPicC,
                yMarg + (gWid * 9) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 15) - hpPicC,
                yMarg + (gWid * 9) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 3) - hpPicC,
                yMarg + (gWid * 15) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 9) - hpPicC,
                yMarg + (gWid * 15) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  rasterop(ROr, hpPicS, hpPicS,
                xMarg + (gWid * 15) - hpPicC,
                yMarg + (gWid * 15) - hpPicC,
                SScreenW, SScreenP,
                0, 0, picWW, hcDot);
  if not printing then
    begin
      SSetCursor(captBX, captY);
      write('Black Captures');
      SSetCursor(captWX, captY);
      write('White Captures');
    end
  else
    begin
      for i := 1 to maxPoint + 1 do
        begin
          if i > 9 then
            w := charWidth * 2
          else
            w := charWidth;
          x := ((i - 1) * gWid) + eBX - (w div 2);
          y := eBY + charHeight;
          SSetCursor(x, y);
          write(i:0);
        end;
      for i := 0 to maxPoint do
        begin
          x := eLX - charWidth;
          y := eLY - ((maxPoint - i) * gWid) + (charHeight div 2);
          c := i + ord('A');
          if c >= ord('I') then
            c := c + 1;
          SSetCursor(x, y);
          SPutChr(chr(c));
        end;
    end;
end { drawBoard };

procedure clearBoard;
var
  i, j, xMarg, yMarg, gWid: integer;
begin { clearBoard }
  drawBoard;
  if printing and printLarge then
    begin
      xMarg := pxMargin;
      yMarg := pyMargin;
      gWid := pGridWidth;
    end
  else
    begin
      xMarg := xMargin;
      yMarg := yMargin;
      gWid := gridWidth;
    end;
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[1],
                                 xMarg + (0 * gWid) - patchC,
                                 yMarg + (0 * gWid) - patchC,
                                 SScreenW, SScreenP);
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[2],
                                 xMarg + (6 * gWid) - patchC,
                                 yMarg + (0 * gWid) - patchC,
                                 SScreenW, SScreenP);
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[3],
                                 xMarg + (18 * gWid) - patchC,
                                 yMarg + (0 * gWid) - patchC,
                                 SScreenW, SScreenP);
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[4],
                                 xMarg + (0 * gWid) - patchC,
                                 yMarg + (6 * gWid) - patchC,
                                 SScreenW, SScreenP);
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[5],
                                 xMarg + (6 * gWid) - patchC,
                                 yMarg + (6 * gWid) - patchC,
                                 SScreenW, SScreenP);
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[6],
                                 xMarg + (18 * gWid) - patchC,
                                 yMarg + (6 * gWid) - patchC,
                                 SScreenW, SScreenP);
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[7],
                                 xMarg + (0 * gWid) - patchC,
                                 yMarg + (18 * gWid) - patchC,
                                 SScreenW, SScreenP);
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[8],
                                 xMarg + (6 * gWid) - patchC,
                                 yMarg + (18 * gWid) - patchC,
                                 SScreenW, SScreenP);
  rasterop(RRpl, patchS, patchS, 0, 0, picWW, patch[9],
                                 xMarg + (18 * gWid) - patchC,
                                 yMarg + (18 * gWid) - patchC,
                                 SScreenW, SScreenP);
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      board[i][j].val := empty;
  if not printing then
    remPass;
end { clearBoard };

procedure showPlayHistory(isDiagram: boolean);
var
  curRow, curCol, bx, by, bLim, curNum: integer;
  cm, scm, tm: pMRec;
  c: char;
  needWipe, lastCapt: boolean;

  procedure getMarks;
  var
    bx, by, lbx, lby, gx, gy, sMark, x, y, w: integer;
    curC: char;
    done: boolean;
  begin { getMarks }
    lbx := -1;
    lby := -1;
    curC := 'a';
    sMark := 0;
    prompt('Point at locations to place marks - press off board to stop');
    while tabSwitch do;
    done := false;
    setFont(goSLetFont);
    sChrFunc(rOr);
    repeat
      while not tabSwitch do;
      if bLocCur(tabRelX, tabRelY, bx, by, gx, gy) then
        begin
          if printLarge then
            begin
              x := bx * pGridWidth + pxMargin;
              y := by * pGridWidth + pyMargin;
            end
          else
            begin
              x := bx * GridWidth + xMargin;
              y := by * GridWidth + yMargin;
            end;
          if board[bx, by].val = empty then
            begin
              rasterop(rXor, 20, 30, x - 10, y - 15, SScreenW, SScreenP,
                                     x - 10, y - 15, SScreenW, SScreenP);
              w := goSLetFont^.index[ord(curC)].width - 2;
              SSetCursor(x - (w div 2), y + 7);
              write(curC);
              curC := chr(ord(curC) + 1);
            end
          else
            begin
              x := x - sPicC;
              y := y - sPicC;
              if (bx = lbx) and (by = lby) then
                begin
                  if sMark <= maxSMark then
                    begin
                      rasterop(RXor, sPicS, sPicS, x, y, SScreenW, SScreenP,
                                             0, 0, picWW, stoneMarks[sMark]);
                      sMark := sMark + 1;
                    end
                  else
                    sMark := 0;
                end
              else
                sMark := 0;
              if sMark <= maxSMark then
                rasterop(RXor, sPicS, sPicS, x, y, SScreenW, SScreenP,
                                             0, 0, picWW, stoneMarks[sMark]);
            end;
          lbx := bx;
          lby := by;
        end
      else
        done := true;
      while tabSwitch do;
    until done;
    sChrFunc(rRpl);
    setFont(sysFont);
    prompt('');
  end { getMarks };

begin { showPlayHistory }
  if not isDiagram then
    begin
      bLim := 99;
      sNumBase := 0;
      sNumStart := 0;
    end
  else
    bLim := 1000;
  curNum := 0;
  needWipe := true;
  wipeTreeMarks;
  cm := curMove;
  while cm <> treeRoot do
    begin
      cm^.mark := true;
      cm := cm^.blink;
    end;
  repeat
    if needWipe then
      begin
        rasterop(rAndNot, 768, 1024 - extraYO,
                 0, extraYO, SScreenW, SScreenP,
                 0, extraYO, SScreenW, SScreenP);
        curRow := 0;
        curCol := 0;
        showAllStones;
        needWipe := false;
      end;
    cm := cm^.flink;
    while not cm^.mark do
      cm := cm^.slink;
    with cm^ do
      case id of
        hcPlay:
          begin
            addHCStones(hcNum);
            curNum := 1;
          end;
        move:
          begin
            if board[mx, my].val <> empty then
              begin
                bx := curCol * (20 * charWidth) + extraXO;
                by := curRow * charHeight * 2 + extraYO + charHeight;
                SSetCursor(bx, by);
                if who = black then
                  write('Black ')
                else
                  write('White ');
                write((moveN - sNumBase):0, ' at ');
                c := chr(my + ord('A'));
                if c >= 'I' then
                  c := chr(ord(c) + 1);
                write(c, '-', (mx + 1):0);
                curRow := curRow + 1;
                if (curRow * charHeight * 2 + extraYO + charHeight) > 1000 then
                  begin
                    curRow := 0;
                    curCol := curCol + 1;
                  end;
              end
            else
              placeStone(who, mx, my, 0, 0, moveN);
            curNum := moveN;
            lastCapt := false;
            repeat
              if cm^.flink = nil then
                lastCapt := true
              else if cm^.flink^.id = remove then
                begin
                  cm := cm^.flink;
                  if curNum < sNumBase then
                    remStone(cm^.mx, cm^.my);
                end
              else
                lastCapt := true;
            until lastCapt;
          end;
        pass:
          begin
            if not isDiagram then
              begin
                bx := curCol * (20 * charWidth) + extraXO;
                by := curRow * charHeight * 2 + extraYO + charHeight;
                SSetCursor(bx, by);
                if who = black then
                  write('Black ')
                else
                  write('White ');
                write((moveN - sNumBase):0, ' - Pass');
                curRow := curRow + 1;
                if (curRow * charHeight * 2 + extraYO + charHeight) > 1000 then
                  begin
                    curRow := 0;
                    curCol := curCol + 1;
                  end;
              end;
            curNum := moveN;
          end;
      end { case };
    if (curNum = bLim) or
       (cm = curMove) then
      begin
        if isDiagram then
          getMarks;
        csdx;
        if cm <> curMove then
          begin
            sNumBase := bLim + 1;
            bLim := bLim + 100;
            needWipe := true;
            clearBoard;
            scm := curMove;
            curMove := treeRoot;
            switchBranch(cm);
            curMove := scm;
            wipeTreeMarks;
            tm := curMove;
            while tm <> treeRoot do
              begin
               tm^.mark := true;
               tm := tm^.blink;
              end;
          end;
      end;
  until cm = curMove;
  sNumBase := 0;
  sNumStart := 0;
end { showPlayHistory };

procedure printBoard(isDiagram: boolean);
label
  1;
var
  sseg: integer;
  neWas: boolean;
  cmSave: pMRec;

  procedure showFName;
  var
    fnX, fnY: integer;
    fs: string;
  begin { showFName }
    getFNameString(fs);
    if fs <> '' then
      begin
        fnY := charHeight + 8;
        fnX := 384 - (charWidth * length(fs) div 2);
        SSetCursor(fnX, fnY);
        write(fs);
      end;
  end { showFName };

  procedure showComments(isDiagram: boolean);
  var
    cx: integer;
    cs: string;
  begin { showComments }
    if not isDiagram then
      if getComment(treeRoot, cs) then
        begin
          cx := 384 - (charWidth * length(cs) div 2);
          SSetCursor(cx, rCmtY);
          write(cs);
        end;
    if getComment(curMove, cs) then
      begin
        cx := 384 - (charWidth * length(cs) div 2);
        if isDiagram then
          SSetCursor(cx, charHeight + 8)
        else
          SSetCursor(cx, lCmtY);
        write(cs);
      end;
  end { showComments };

  handler ctlC;
  begin { ctlC }
    IOKeyClear;
    resetInput;
    write(''); {control-G}
    prompt('');
    goto 1;
  end { ctlC };

  function readNum(pmpt: string): integer;
  label
    2;
  var
    n: integer;

    handler notNumber(fn: pathName);
    begin { notNumber }
      write(''); {control-G}
      prompt('Bad Number - try again: ');
      goto 2;
    end { notNumber };

    handler pastEOF(fn: pathName);
    begin { pastEOF }
      write(''); {control-G}
      goto 1;
    end { pastEOF };

  begin { readNum }
    prompt('');
  2:
    resetInput;
    write(pmpt);
    readln(n);
    readNum := n;
  end { readNum };

begin { printBoard }
  if curMove = treeRoot then
    begin
      write(''); {control-G}
      exit(printBoard);
    end;
  cmSave := curMove;
  if scrSavPtr = nil then
    begin
      createSegment(sseg, 192, 1, 192);
      scrSavPtr := makePtr(sseg, 0, rasterPtr);
    end;
  rasterop(rRpl, 768, 1024, 0, 0, SScreenW, scrSavPtr,
                            0, 0, SScreenW, SScreenP);
  rasterop(rAndNot, 768, 1024, 0, 0, SScreenW, SScreenP,
                               0, 0, SScreenW, SScreenP);
  printing := true;
  neWas := numbEnabled;
  numbEnabled := true;
  sNumBase := 0;
  sNumStart := 0;
  drawBoard;
  bigNums := false;
  showAllStones;
  if not isDiagram then
    begin
      showComments(false);
      showFName;
      csdx;
    end
  else
    begin
      sNumBase := readNum('Start Numbering at which stone? ');
      sNumStart := readNum('First Number is? ');
      prompt('');
    end;
  clearBoard;
  bigNums := true;
  if isDiagram then
    showComments(true);
  showPlayHistory(isDiagram);
1:
  rasterop(rRpl, 768, 1024, 0, 0, SScreenW, SScreenP,
                            0, 0, SScreenW, scrSavPtr);
  printing := false;
  numbEnabled := neWas;
  bigNums := false;
  sNumBase := 0;
  sNumStart := 0;
  clearBoard;
  curMove := treeRoot;
  captures[black] := 0;
  captures[white] := 0;
  switchBranch(cmSave);
  curMove := cmSave;
end { printBoard };

procedure refreshBoard;
begin { refreshBoard }
  drawBoard;
  showAllStones;
  dotSX := -1;
  dotLast;
end { refreshBoard };

{ initializes this module }
procedure initGoBoard;

  procedure beepInit;
  const
    size = (WordSize(beepBuf) * 7 + 255) div 256;
  var
    d: SoundType;
    i,j: integer;
    beepSeg: integer;
  begin { beepInit }
    createSegment(beepSeg, size, 1, size);
    new(0,4,StatPtr);
    for d := atari to die3 do
      new(beepSeg, 4, sounds[d]);
    for i := 0 to 63 do
      begin
        sounds[atari]^[i] := 511;
        case i mod 3 of
          0: sounds[koV]^[i] := -5;
          1: sounds[koV]^[i] := 34;
          2: sounds[koV]^[i] := 0;
        end;
        case i mod 4 of
          0: sounds[s3]^[i] := 1023;
          1: sounds[s3]^[i] := 0;
          2: sounds[s3]^[i] := -1;
          3: sounds[s3]^[i] := -1023;
        end;
       case i mod 5 of
          0: sounds[s4]^[i] := 43;
          1: sounds[s4]^[i] := 765;
          2: sounds[s4]^[i] := -432;
          3: sounds[s4]^[i] := -6;
          4: sounds[s4]^[i] := 345;
       end;
     end;
   for i := 0 to 1 do
     for j := 0 to 15 do
       begin
         sounds[die]^[i*32+j] := -1;
         sounds[die]^[i*32+16+j] := 0;
       end;
   for i := 0 to 63 do
     begin
       sounds[die2]^[i] := sounds[die]^[i];
       sounds[die3]^[i] := sounds[die]^[i];
     end;
  end { beepInit };

  procedure definePats;
  var
    i, j, blks, gbg: integer;
    fid: fileID;
  begin { definePats }
    fid := FSLookup('go.animate', blks, gbg);
    if fid = 0 then
      begin
        writeln('GO.ANIMATE not found');
        raise gbFatal;
      end
    else if blks < 8 then
      begin
        writeln('GO.ANIMATE too short');
        raise gbFatal;
      end;
    new(0, 4, stones[black]);
    FSBlkRead(fid, 0, recast(stones[black], pDirBlk));
    new(0, 4, stones[white]);
    FSBlkRead(fid, 1, recast(stones[white], pDirBlk));
    new(0, 4, hcDot);
    FSBlkRead(fid, 2, recast(hcDot, pDirBlk));
    new(0, 4, selCursor);
    FSBlkRead(fid, 3, recast(selCursor, pDirBlk));
    new(0, 4, stoneCir);
    FSBlkRead(fid, 4, recast(stoneCir, pDirBlk));
    new(0, 4, stoneMarks[0]);
    FSBlkRead(fid, 5, recast(stoneMarks[0], pDirBlk));
    new(0, 4, stoneMarks[1]);
    FSBlkRead(fid, 6, recast(stoneMarks[1], pDirBlk));
    new(0, 4, stoneMarks[2]);
    FSBlkRead(fid, 7, recast(stoneMarks[2], pDirBlk));
    new(0, 4, htBuf);
    for i := 0 to 47 do
      htBuf^[0, i] := #125252;
    for i := 0 to 47 do
      htBuf^[1, i] := 0;
    for i := 0 to 47 do
      htBuf^[2, i] := #125252;   { #52525 }
    for i := 0 to 47 do
      htBuf^[3, i] := 0;
    for i := 1 to 9 do
      new(0, 4, patch[i]);
  end { definePats };

  procedure setupFont;
  var
    bblks, sblks, tBlks, lBlks, bits, fontseg, i: integer;
    bFID, sFID, tFID, lFID: fileID;
    bp: pDirBlk;
  begin { setupFont }
    sysFont := getFont;
    bFID := FSLookup('goBNum.kst', bblks, bits);
    if bFID = 0 then
      begin
        writeln('goBNum.KST not found');
        raise gbFatal;
      end;
    sFID := FSLookup('goSNum.kst', sblks, bits);
    if sFID = 0 then
      begin
        writeln('goSNum.KST not found');
        raise gbFatal;
      end;
    tFID := FSLookup('goTNum.kst', tblks, bits);
    if sFID = 0 then
      begin
        writeln('goTNum.KST not found');
        raise gbFatal;
      end;
    lFID := FSLookup('goSLets.kst', lBlks, bits);
    if lFID = 0 then
      begin
        writeln('goSLets.KST not found');
        raise gbFatal;
      end;
    createSegment(fontseg, bblks + sblks + tBlks + lBlks, 1,
                  bblks + sblks + tBlks + lBlks);
    for i := 0 to bblks - 1 do
      begin
        bp := makePtr(fontSeg, i * 256, pDirBlk);
        FSBlkRead(bFID, i, bp);
      end;
    goBNumFont := makePtr(fontseg, 0, fontPtr);
    for i := 0 to sblks - 1 do
      begin
        bp := makePtr(fontSeg, (i + bblks) * 256, pDirBlk);
        FSBlkRead(sFID, i, bp);
      end;
    goSNumFont := makePtr(fontseg, bblks * 256, fontPtr);
    for i := 0 to tblks - 1 do
      begin
        bp := makePtr(fontSeg, (i + bblks + sBlks) * 256, pDirBlk);
        FSBlkRead(tFID, i, bp);
      end;
    goTNumFont := makePtr(fontseg, (bblks  + sBlks) * 256, fontPtr);
    for i := 0 to lBlks - 1 do
      begin
        bp := makePtr(fontSeg, (i + bblks + sBlks + tBlks) * 256, pDirBlk);
        FSBlkRead(lFID, i, bp);
      end;
    goSLetFont := makePtr(fontseg, (bblks  + sBlks + tBlks) * 256, fontPtr);
  end { setupFont };

begin { initGoBoard }
  printing := false;
  beepInit;
  definePats;
  setupFont;
  scrSavPtr := nil;
  sNumBase := 0;
  sNumStart := 0;
  bigNums := false;
end. { initGoBoard }

SHAR_EOF
fi
if test -f 'goCom.pas'
then
    echo shar: "will not over-write existing file 'goCom.pas'"
else
cat << \SHAR_EOF > 'goCom.pas'
{---------------------------------------------------------------------------}
{ goCom.Pas                                                                 }
{                                                                           }
{ Common Data for Go                                                        }
{ Copyright (c) 1982 by Three Rivers Computer Corp.                         }
{                                                                           }
{ Written: June 3, 1982 by Stoney Ballard                                   }
{ Edit History:                                                             }
{    June  3, 1982 Started                                                  }
{    June  4, 1982 Add dead group removal                                   }
{    June 10, 1982 Use new go file manager                                  }
{    Nov   9, 1982 Split From Go.Pas                                        }
{ V3.5 - Jan 11, 1983 Fixed bug in printer that screwed capture count       }
{ V3.6 - Jan 14, 1983 Changed Scoring and board coordinates to conform to   }
{                     tournament rules                                      }
{ V3.7 - Jan 17, 1983 added computer player!!!!                             }
{ V3.8 - Mar  8, 1983 Added PrintDiagram                                    }
{                     Made board 34 grid for printing                       }
{ V3.9 - May  3, 1983 Add board print size switch and command               }
{---------------------------------------------------------------------------}


module goCom;

exports

imports IO_Others from IO_Others;
imports fileDefs from fileDefs;

const
  version = '3.9';

  numPoints = 19;
  maxPoint = numPoints - 1;
  curC = 31;
  maxTagLen = 16;

  charHeight = 13;
  charWidth = 9;

  boardWin = 1;
  menuWin = 2;
  statWin = 3;
  bWinX = 0;
  bWinY = 0;
  bWinW = 768;
  bWinH = 768;
  mWinX = 0;
  mWinY = 768;
  mWinW = 768;
  mWinH = 192;
  sWinX = 0;
  sWinY = 960;
  sWinW = 768;
  sWinH = 64;

  promptX = sWinX + 32;
  lineY = 4;
  lineDel = 2;
  promptLine = 1;
  tagLine = 2;
  cmtLine = 3;

  boardX = bWinX + 64;
  boardY = bWinY + 32;
  pBoardX = bWinX + 44;  { for printing }
  pBoardY = bWinY + 24;

  passX = bWinX + 321;
  passY = bWinY + 712;  { 712 }
  passW = 126;
  passH = 13;

  captBX = bWinX + 64;
  captWX = bWinX + 578;
  captY = bWinY + 712;  { 712 }

  captNBX = captBX + 45;
  captNWX = captWX + 45;
  captNY = bWinY + 732; { 732 }

  turnX = bWinX + 325;
  turnY = bWinY + 752;  { 752 }

  none = -1;
  mInit = 1;
  mSetHc = 2;
  mPass = 3;
  mScore = 4;
  mForToBr = 5;
  mBackToBr = 6;
  mBackToStone = 7;
  mForToLeaf = 8;
  mPutTag = 9;
  mGotoTag = 10;
  mGotoRoot = 11;
  mPutCmt = 12;
  mReadFile = 13;
  mWriteFile = 14;
  mPruneBranches = 15;
  mTogNums = 16;
  mPrintBoard = 17;
  mStepToTag = 18;
  mSetStepTag = 19;
  mQuit = 20;
  mBackOne = 21;
  mForOne = 22;
  mEraseMove = 23;
  mAutoPlay = 24;
  mPlayMyself = 25;
  mSetPlayLevel = 26;
  mDebug = 27;
  mRefBoard = 28;
  mShoState = 29;
  mPrintDiag = 30;
  mBoardSize = 31;
  mLast = 31;  { the last command in the menu }
  mPlaceStone = 32;  { this command is not in the menu }
  mCtlC = 33;   { nor is this }

type
  bVal = (black, white, empty, alternate);
  sType = black..white;
  bRec = record
           val: bval;
           xOfs, yOfs: integer;
           mNum: integer;
           marked: boolean;
         end;

  boardArray = array[0..maxPoint] of array[0..maxPoint] of bRec;

  picBuf = array[0..63] of array[0..3] of integer;
  pPicBuf = ^picBuf;

var
  board: boardArray;
  captures: array[sType] of integer;
  moveNum: integer;
  koX, koY: integer;
  selCursor: curPatPtr;
  dotSX, dotSY: integer;
  passShowing: boolean;
  numbEnabled: boolean;
  treeDirty: boolean;
  gameFName: pathName;
  debug: boolean;
  printLarge: boolean;

private

procedure comBug;
begin { comBug }
end. { comBug }
SHAR_EOF
fi
if test -f 'goMenu.pas'
then
    echo shar: "will not over-write existing file 'goMenu.pas'"
else
cat << \SHAR_EOF > 'goMenu.pas'
{---------------------------------------------------------------}
{ Go Menu Manager                                               }
{ Copyright (c) 1982 by Three Rivers Computer Corp.             }
{                                                               }
{ Written: December 3, 1982 by Stoney Ballard                   }
{ Edit History:                                                 }
{                                                               }
{   Jan  5, 1983 - Fixed bug in menu select                     }
{   Jan 27, 1983 - added setPlayLevel                           }
{---------------------------------------------------------------}

module goMenu;

exports

imports fileDefs from fileDefs;
imports goTree from goTree;

procedure initMenu;
function getMenuCmd: integer;
procedure endCmd;
procedure putMString(cmd: integer; ms: string);
procedure activate(cmd: integer; act: boolean);
procedure restoreCursor;
function confirmed: boolean;
function menuGoFile(var fName: pathName): boolean;
procedure waitNoButton;
procedure waitButton;
procedure clearLine(ln: integer);
procedure prompt(s: string);
procedure showComment;
procedure showTag;
function getHCMenu: integer;
function getTagMenu: tagPtr;
procedure setMenuCursor;
procedure menuPlayLevel(var playLevel: integer; maxLevel: integer);

private

imports goCom from goCom;
imports goMgr from goMgr;
imports popUp from popUp;
imports raster from raster;
imports screen from screen;
imports IO_Others from IO_Others;
imports fileSystem from fileSystem;
imports fileUtils from fileUtils;
imports perq_String from perq_String;

const
  mWidth = 180;
  mHeight = 18;
  mLBorder = 12;
  mTBorder = 10;
  mVSpacing = mHeight + 4;
  mHSpacing = mWidth + 8;
  grHeight = mHeight - 2;
  grWidth = (((mWidth - 2 + 15) div 16 + 3) div 4) * 4;

type
  mStr = string[20];

  menuBox = record
              leftX, topY, rightX, botY: integer;
              isAct: boolean;
              str: mStr;
            end;

  greyPat = array[0..grHeight - 1] of array[0..grWidth - 1] of integer;
  pGreyPat = ^greyPat;

var
  mItems: array[1..mLast] of menuBox;
  curHiLi, curCmd: integer;
  mGreyP: pGreyPat;
  isMenuCursor: boolean;
  valDesc: pNameDesc;
  cnfDesc: pNameDesc;
  res: resRes;
  goFNames: array[1..1024] of string[25];
  tabXPos, tabYPos: integer;

procedure restoreCursor;
begin { restoreCursor }
  if isMenuCursor then
    IOLoadCursor(defaultCursor, 0, 0)
  else
    IOLoadCursor(selCursor, curC, curC);
end { restoreCursor };

procedure waitNoButton;
begin { waitNoButton }
  while tabYellow or tabWhite or tabGreen or tabBlue or tabSwitch do;
end { waitNoButton };

procedure waitButton;
begin { waitButton }
  while not tabSwitch do;
end { waitButton };

procedure menuPlayLevel(var playLevel: integer; maxLevel: integer);
var
  plMenu: pNameDesc;
  i: integer;
  res: resres;

  handler outside;
  begin { outside }
    destroyNameDesc(plMenu);
    write(''); {control-G}
    waitNoButton;
    exit(menuPlayLevel);
  end { outside };

begin { menuPlayLevel }
  allocNameDesc(maxLevel + 1, 0, plMenu);
  plMenu^.header := 'Play Level?';
  for i := 0 to maxLevel do
    begin
{$R-}
      plMenu^.commands[i + 1] := intToStr(i);
{$R=}
    end;
  menu(plMenu, false, 1, maxLevel + 1, -1, -1, -1, res);
  playLevel := res^.indices[1] - 1;
  destroyRes(res);
  destroyNameDesc(plMenu);
end { menuPlayLevel };

function getTagMenu: tagPtr;
var
  tp: tagPtr;
  nTags, tIdx, i: integer;
  tMenu: pNameDesc;
  res: resres;

  handler outside;
  begin { outside }
    destroyNameDesc(tMenu);
    write(''); {control-G}
    waitNoButton;
    exit(getTagMenu);
  end { outside };

begin { getTagMenu }
  getTagMenu := nil;
  tp := treeRoot^.lastTag;
  nTags := 0;
  while tp <> nil do
    begin
      nTags := nTags + 1;
      tp := tp^.nextTag;
    end;
  if nTags = 0 then
    write('') {control-G}
  else
    begin
      tp := treeRoot^.lastTag;
      allocNameDesc(nTags, 0, tMenu);
      tMenu^.header := 'Which Tag?';
      for i := nTags downTo 1 do
        begin
{$R-}
          tMenu^.commands[i] := tp^.sTag;
{$R=}
          tp := tp^.nextTag;
        end;
      menu(tMenu, false, 1, nTags, -1, -1, -1, res);
      restoreCursor;
      tIdx := nTags - res^.indices[1];
      destroyRes(res);
      destroyNameDesc(tMenu);
      tp := treeRoot^.lastTag;
      for i := 1 to tIdx do
        tp := tp^.nextTag;
      getTagMenu := tp;
    end;
end { getTagMenu };

procedure clearLine(ln: integer);
var
  lY: integer;
begin { clearLine }
  lY := winTable[statWin].winTY +
        (ln * (charHeight + lineDel)) + lineY - charHeight;
  rasterop(RAndNot, sWinW - promptX - 32, charHeight,
                    promptX, lY, SScreenW, SScreenP,
                    promptX, lY, SScreenW, SScreenP);
end { clearLine };

procedure posLine(ln: integer);
var
  lY: integer;
begin { posLine }
  clearLine(ln);
  lY := winTable[statWin].winTY + (ln * (charHeight + lineDel)) + lineY;
  SSetCursor(promptX, lY);
end { posLine };

procedure prompt(s: string);
begin { prompt }
  posLine(promptLine);
  write(s);
end { prompt };

procedure showTag;
var
  ts: string;
begin { showTag }
  posLine(tagLine);
  if getTag(curMove, ts) then
    write('Tag: ', ts);
end { showTag };

procedure showComment;
var
  cs: string;
begin { showComment }
  posLine(cmtLine);
  if getComment(curMove, cs) then
    write('Comment: ', cs);
end { showComment };

function getHCMenu: integer;
var
  res: resres;

  handler outside;
  begin { outside }
    restoreCursor;
    getHCMenu := none;
    write(''); {control-G}
    exit(getHCMenu);
  end { outside };

begin { getHCMenu }
  menu(valDesc, false, 1, 8, -1, -1, -1, res);
  restoreCursor;
  getHCMenu := res^.indices[1] + 1;
  destroyRes(res);
end { getHCMenu };

function menuGoFile(var fName: pathName): boolean;
var
  fi, i: integer;
  fid: fileID;
  fileMenu: pNameDesc;
  res: resres;
  scanP: ptrScanRecord;

  function isGoFName(var rName: string): boolean;
  var
    ts: string;
  begin { isGoFName }
    isGoFName := false;
    ts := rName;
    convUpper(ts);
    if length(ts) < 3 then
      exit(isGoFName);
    ts := subStr(ts, length(ts) - 2, 3);
    if ts = '.GO' then
      begin
        rName := subStr(rName, 1, length(rName) - 3);
        isGoFName := true;
      end;
  end { isGoFName };

  handler outside;
  begin { outside }
    destroyNameDesc(fileMenu);
    restoreCursor;
    menuGoFile := false;
    write(''); {control-G}
    exit(menuGoFile);
  end { outside };

begin { menuGoFile }
  new(scanP);
  scanP^.initialCall := true;
  scanP^.dirName := '';
  prompt('Scanning Directory...');
  fi := 0;
  while FSScan(scanP, fName, fid) do
    if isGoFName(fName) then
      begin
        fi := fi + 1;
        goFNames[fi] := fName;
      end;
  dispose(scanP);
  prompt('');
  if fi < 1 then
    begin
      prompt('No GO files found');
      menuGoFile := false;
      exit(menuGoFile);
    end;
  allocNameDesc(fi, 0, fileMenu);
  fileMenu^.header := 'Available Games';
  for i := 1 to fi do
    begin
{$R-}
      fileMenu^.commands[i] := goFNames[i];
{$R=}
    end;
  menu(fileMenu, false, 1, fi, -1, -1, -1, res);
  restoreCursor;
  destroyNameDesc(fileMenu);
  fName := goFNames[res^.indices[1]];
  destroyRes(res);
  menuGoFile := true;
end { menuGoFile };

function confirmed: boolean;

  handler outside;
  begin { outside }
    confirmed := false;
    restoreCursor;
    exit(confirmed);
  end { outside };

begin { confirmed }
  if treeDirty then
    begin
      menu(cnfDesc, false, 1, 2, -1, -1, -1, res);
      restoreCursor;
      confirmed := res^.indices[1] = 2;
      destroyRes(res);
    end
  else
    confirmed := true;
end { confirmed };

procedure activate(cmd: integer; act: boolean);
var
  dFun: lineStyle;
begin { activate }
  with mItems[cmd] do
    begin
      isAct := act;
      if isAct then
        dFun := drawLine
      else
        dFun := eraseLine;
      line(dFun, leftX, topY, rightX, topY, SScreenP);
      line(dFun, leftX, botY, rightX, botY, SScreenP);
      line(dFun, leftX, topY, leftX, botY, SScreenP);
      line(dFun, rightX, topY, rightX, botY, SScreenP);
    end;
end { activate };

function findItem(x, y: integer): integer;
var
  i: integer;
begin { findItem }
  for i := 1 to mLast do
    with mItems[i] do
      if isAct then
        if (x >= leftX) and (x <= rightX) and
           (y >= topY) and (y <= botY) then
          begin
            findItem := i;
            exit(findItem);
          end;
  findItem := none;
end { findItem };

procedure invertItem(cmd: integer);
begin { invertItem }
  with mItems[cmd] do
    rasterop(rNot, mWidth - 2, mHeight - 2,
                   leftX + 1, topY + 1, SScreenW, SScreenP,
                   leftX + 1, topY + 1, SScreenW, SScreenP);
end { invertItem };

procedure checkHighLight;
var
  cmd: integer;
begin { checkHighLight }
  cmd := findItem(tabXPos, tabYPos);
  if cmd <> curHiLi then
    begin
      if curHiLi <> none then
        invertItem(curHiLi);
      if cmd <> none then
        invertItem(cmd);
      curHiLi := cmd;
    end;
end { checkHighLight };

procedure writeMStr(cmd, cFunc: integer);
begin { writeMStr }
  SChrFunc(cFunc);
  with mItems[cmd] do
    begin
      SSetCursor(leftX + 9, botY - 2);
      write(str);
    end;
  SChrFunc(rRpl);
end { writeMStr };

procedure xorGrey(cmd: integer);
begin { xorGrey }
  if (cmd <> none) and (cmd <= mLast) then
    with mItems[cmd] do
      rasterop(rXor, mWidth - 2, mHeight - 2,
                     leftX + 1, topY + 1, SScreenW, SScreenP,
                     0, 0, grWidth, mGreyP);
end { xorGrey };

procedure selItem(cmd: integer);
begin { selItem }
  xorGrey(cmd);
  writeMStr(cmd, rOr);
end { selItem };

procedure deSelItem(cmd: integer);
begin { deSelItem }
  xorGrey(cmd);
  writeMStr(cmd, rAndNot);
end { deSelItem };

procedure setMenuCursor;
begin { setMenuCursor }
  if not isMenuCursor then
    begin
      IOLoadCursor(defaultCursor, 0, 0);
      isMenuCursor := true;
    end;
end { setMenuCursor };

function getMenuCmd: integer;
var
  cmd, nCmd: integer;
  gOn: boolean;
begin { getMenuCmd }
  tabXPos := tabRelX;
  tabYPos := tabRelY;
  with winTable[boardWin] do
    if (tabXPos >= winLX) and (tabXPos <= winRX) and
       (tabYPos >= winTY) and (tabYPos <= winBY) then
      begin
        if isMenuCursor then
          IOLoadCursor(selCursor, curC, curC);
        isMenuCursor := false;
      end
    else
      setMenuCursor;
  checkHighLight;
  if not tabSwitch then
    curCmd := none
  else if tabWhite then
    begin
      with mItems[mBackOne] do
        if isAct then
          begin
            cmd := mBackOne;
            if curHiLi <> cmd then
              begin
                if curHiLi <> none then
                  invertItem(curHiLi);
                invertItem(cmd);
              end;
            curHiLi := cmd;
            curCmd := cmd;
            selItem(cmd);
          end
        else
          write(''); {control-G}
      waitNoButton;
    end
  else if tabGreen then
    begin
      with mItems[mForOne] do
        if isAct then
          begin
            cmd := mForOne;
            if curHiLi <> cmd then
              begin
                if curHiLi <> none then
                  invertItem(curHiLi);
                invertItem(cmd);
              end;
            curHiLi := cmd;
            curCmd := cmd;
            selItem(cmd);
          end
        else
          write(''); {control-G}
      waitNoButton;
    end
  else { tabYellow or tabBlue }
    begin
      cmd := findItem(tabXPos, tabYPos);
      if cmd <> none then
        begin
          selItem(cmd);
          gOn := true;
          while tabSwitch do
            begin
              nCmd := findItem(tabRelX, tabRelY);
              if nCmd <> cmd then
                begin
                  if gOn then
                    deSelItem(cmd);
                  gOn := false;
                end
              else
                begin
                  if not gOn then
                    selItem(cmd);
                  gOn := true;
                end;
            end;
          if gOn then
            begin
              curCmd := cmd;
            end
          else
            begin
              write(''); {control-G}
              curCmd := none;
            end;
          waitNoButton;
        end
      else
        with winTable[boardWin] do
          if (tabXPos >= winLX) and (tabXPos <= winRX) and
             (tabYPos >= winTY) and (tabYPos <= winBY) then
            curCmd := mPlaceStone
          else
            begin
              write(''); {control-G}
              curCmd := none;
              waitNoButton;
            end;
    end;
  getMenuCmd := curCmd;
end { getMenuCmd };

procedure endCmd;
begin { endCmd }
  if (curCmd <> none) and (curCmd <= mLast) then
    deSelItem(curCmd);
  curCmd := none;
end { endCmd };

procedure putMString(cmd: integer; ms: string);
begin { putMString }
  if (curCmd = cmd) and (cmd <= mLast) then
    begin
      deSelItem(cmd);
      curCmd := none;
    end;
  with mItems[cmd] do
    begin
      rasterOp(rAndNot, mWidth - 2, mHeight - 2,
               leftX + 1, topY + 1, SScreenW, SScreenP,
               leftX + 1, topY + 1, SScreenW, SScreenP);
      str := ms;
      writeMStr(cmd, rRpl);
      if curHiLi = cmd then
        invertItem(cmd);
    end;
end { putMString };

procedure initMenu;
var
  i, j: integer;

  procedure setItem(cmd, sx, sy: integer; cs: string);
  begin { setItem }
    with mItems[cmd] do
      begin
        leftX := (sx * mHSpacing) + mLBorder + mWinX;
        topY := (sy * mVSpacing) + mTBorder + mWinY;
        isAct := false;
        rightX := leftX + mWidth - 1;
        botY := topY + mHeight - 1;
        putMString(cmd, cs);
      end;
  end { setItem };

begin { initMenu }
  curHiLi := none;
  curCmd := none;
  setItem(mPass, 0, 0, 'Pass');
  setItem(mAutoPlay, 0, 1, 'Generate Move');
  setItem(mPlayMyself, 0, 2, 'Play Myself');
  setItem(mSetPlayLevel, 0, 3, 'Set Play Level');
  setItem(mSetHC, 0, 4, 'Set Handicap');
  setItem(mScore, 0, 5, 'Score');
  setItem(mQuit, 0, 6, 'Quit');
  setItem(mInit, 0, 7, 'Initialize');
  setItem(mBackOne, 1, 0, 'Backup One');
  setItem(mGotoRoot, 1, 1, 'Back to Start');
  setItem(mBackToBr, 1, 2, 'Back to Branch');
  setItem(mBackToStone, 1, 3, 'Back to Stone');
  setItem(mEraseMove, 1, 4, 'Erase Move');
  setItem(mPruneBranches, 1, 5, 'Prune Branches');
  setItem(mDebug, 1, 6, 'Turn Debug On');
  setItem(mWriteFile, 1, 7, 'Write File');
  setItem(mForOne, 2, 0, 'Forward One');
  setItem(mForToLeaf, 2, 1, 'Forward to Leaf');
  setItem(mForToBr, 2, 2, 'Forward to Branch');
  setItem(mStepToTag, 2, 3, 'Step Towards Tag');
  setItem(mGotoTag, 2, 5, 'Go To Tag');
  setItem(mRefBoard, 2, 6, 'Refresh Board');
  setItem(mReadFile, 2, 7, 'Read File');
  setItem(mPutTag, 3, 0, 'Put Tag');
  setItem(mPutCmt, 3, 1, 'Put Comment');
  setItem(mSetStepTag, 3, 2, 'Set Step Tag');
  setItem(mShoState, 3, 3, 'Show Player State');
  setItem(mTogNums, 3, 4, 'Show Stone Numbers');
  setItem(mBoardSize, 3, 5, 'Use Small Board');
  setItem(mPrintBoard, 3, 6, 'Print Board');
  setItem(mPrintDiag, 3, 7, 'Print Diagram');
  initPopUp;
  allocNameDesc(8, 0, valDesc);
  with valDesc^ do
    begin
{$R-}
      header := 'How Many?';
      commands[1] := '2';
      commands[2] := '3';
      commands[3] := '4';
      commands[4] := '5';
      commands[5] := '6';
      commands[6] := '7';
      commands[7] := '8';
      commands[8] := '9';
{$R=}
    end;
  allocNameDesc(2, 0, cnfDesc);
  with cnfDesc^ do
    begin
      header := 'Confirm';
{$R-}
      commands[1] := 'No';
      commands[2] := 'Yes';
{$R=}
    end;
  new(0, 4, mGreyP);
  i := 0;
  repeat
    for j := 0 to (grWidth - 1) do
      case (i mod 4) of
        0, 2:
          mGreyP^[i, j] := #177777;
        1:
          mGreyP^[i, j] := #125252;
        3:
          mGreyP^[i, j] := #052525;
      end;
    i := i + 1;
  until i > (grHeight - 1);
  isMenuCursor := true;
end. { initMenu }

SHAR_EOF
fi
if test -f 'goMgr.pas'
then
    echo shar: "will not over-write existing file 'goMgr.pas'"
else
cat << \SHAR_EOF > 'goMgr.pas'
{---------------------------------------------------------------}
{ GoMgr.Pas                                                     }
{                                                               }
{ Go Game Manager                                               }
{ Copyright (c) 1982 by Three Rivers Computer Corp.             }
{                                                               }
{ Written: June 3, 1982 by Stoney Ballard                       }
{ Edit History:                                                 }
{    June  3, 1982  Started                                     }
{    June  4, 1982  Add dead group removal                      }
{    June 10, 1982  Use new go file manager                     }
{    Nov   9, 1982  Extracted from GO.PAS                       }
{---------------------------------------------------------------}

module goMgr;

exports

imports goCom from goCom;
imports goTree from goTree;

var
  curMove: pMRec;
  gameOver: boolean;
  passIsAlt: boolean;

procedure initGoMgr;
procedure backUp1;
procedure doMove(which: sType; ix, iy, pox, poy: integer);
procedure doPass(which: sType);
procedure doHCPlay(num: integer);
procedure forwardTo(m: pMRec);
procedure forwToBr;
procedure backToBr;
procedure showAlts;
procedure remAlts;
procedure selAlt(lx, ly: integer);
procedure selPass;
function atBranch(cm: pMRec): boolean;
function atLeaf(cm: pMRec): boolean;
procedure checkAtari(cm: pMRec);
procedure switchBranch(bm: pMRec);
procedure scoreGame(var ws, bs: integer);
procedure putEnd;
procedure delGroup(bx, by: integer);
procedure restoreDead;
procedure dotLast;
function lastPlayAt(bx, by: integer): boolean;
procedure doStepTag;
function stepTagPossible: boolean;
procedure wipeTreeMarks;

private

imports goBoard from goBoard;
imports goMenu from goMenu;
imports screen from screen;

type
  deadRec = record
              dx, dy, dox, doy, mn: integer;
              whoDead: sType;
            end;

var
  killX, killY: integer;
  endDead: array[1..361] of deadRec;
  numEndDead: integer;

procedure wipeMarks;
var
  i, j: integer;
begin { wipeMarks }
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      board[i, j].marked := false;
end { wipeMarks };

procedure wipeTreeMarks;

  procedure recWipe(m: pMRec);
  begin { recWipe }
    while m <> nil do
      begin
        recWipe(m^.slink);
        m^.mark := false;
        m := m^.flink;
      end;
  end { recWipe };

begin { wipeTreeMarks }
  treeRoot^.mark := false;
  if treeRoot^.flink <> nil then
    recWipe(treeRoot^.flink);
end { wipeTreeMarks };

procedure spanGroup(s: sType; xi, yi: integer; var libs, size: integer);
begin { spanGroup }
  if (xi >= 0) and (xi <= maxPoint) and
     (yi >= 0) and (yi <= maxPoint) then
    with board[xi, yi] do
      if not marked then
        if val = empty then
          begin
            libs := libs + 1;
            marked := true;
          end
        else if val = s then
          begin
            marked := true;
            size := size + 1;
            spanGroup(s, xi - 1, yi, libs, size);
            spanGroup(s, xi + 1, yi, libs, size);
            spanGroup(s, xi, yi - 1, libs, size);
            spanGroup(s, xi, yi + 1, libs, size);
          end;
end { spanGroup };

function libertyCount(xi, yi: integer): integer;
var
  libs, size: integer;
begin { libertyCount }
  wipeMarks;
  libs := 0;
  size := 0;
  spanGroup(board[xi, yi].val, xi, yi, libs, size);
  libertyCount := libs;
end { libertyCount };

function groupSize(xi, yi: integer): integer;
var
  gbg, size: integer;
begin { groupSize }
  wipeMarks;
  size := 0;
  gbg := 0;
  spanGroup(board[xi, yi].val, xi, yi, gbg, size);
  groupSize := size;
end { groupSize };

procedure killGroup(s: sType; xi, yi: integer);
begin { killGroup }
  if (xi >= 0) and (xi <= maxPoint) and
     (yi >= 0) and (yi <= maxPoint) then
    with board[xi, yi] do
      if val = s then
        begin
          remStone(xi, yi);
          curMove := newMove(curMove);
          with curMove^ do
            begin
              mx := xi;
              my := yi;
              ox := board[xi, yi].xOfs;
              oy := board[xi, yi].yOfs;
              moveN := board[xi, yi].mNum;
              who := s;
              id := remove;
            end;
          curMove := mergeMove(curMove);
          killGroup(s, xi - 1, yi);
          killGroup(s, xi + 1, yi);
          killGroup(s, xi, yi - 1);
          killGroup(s, xi, yi + 1);
        end;
end { killGroup };

procedure remDead(xi, yi: integer; var numDead: integer);
var
  i, j, libs, size: integer;
  s, other: bVal;

begin { remDead }
  numDead := 0;
  s := board[xi, yi].val;
  if s = white then
    other := black
  else
    other := white;
  if xi > 0 then
    if (board[xi - 1, yi].val = other) then
      begin
        wipeMarks;
        libs := 0;
        size := 0;
        spanGroup(other, xi - 1, yi, libs, size);
        if libs = 0 then
          begin
            killGroup(other, xi - 1, yi);
            numDead := numDead + size;
            killX := xi - 1;
            killY := yi;
          end;
      end;
  if xi < maxPoint then
    if (board[xi + 1, yi].val = other) then
      begin
        wipeMarks;
        libs := 0;
        size := 0;
        spanGroup(other, xi + 1, yi, libs, size);
        if libs = 0 then
          begin
            killGroup(other, xi + 1, yi);
            numDead := numDead + size;
            killX := xi + 1;
            killY := yi;
          end;
      end;
  if yi > 0 then
    if (board[xi, yi - 1].val = other) then
      begin
        wipeMarks;
        libs := 0;
        size := 0;
        spanGroup(other, xi, yi - 1, libs, size);
        if libs = 0 then
          begin
            killGroup(other, xi, yi - 1);
            numDead := numDead + size;
            killX := xi;
            killY := yi - 1;
          end;
      end;
  if yi < maxPoint then
    if (board[xi, yi + 1].val = other) then
      begin
        wipeMarks;
        libs := 0;
        size := 0;
        spanGroup(other, xi, yi + 1, libs, size);
        if libs = 0 then
          begin
            killGroup(other, xi, yi + 1);
            numDead := numDead + size;
            killX := xi;
            killY := yi + 1;
          end;
      end;
  if numDead > 0 then
    beep(die);
end { remDead };

function lastPlayAt(bx, by: integer): boolean;
var
  tm: pMRec;
begin { lastPlayAt }
  lastPlayAt := false;
  tm := curMove;
  while tm <> treeRoot do
    with tm^ do
      if id = move then
        begin
          lastPlayAt := (mx = bx) and (my = by);
          exit(lastPlayAt);
        end
      else if id = pass then
        exit(lastPlayAt)
      else if id = hcPlay then
        exit(lastPlayAt)
      else
        tm := tm^.blink;
end { lastPlayAt };

procedure findAtari(xi, yi: integer);
var
  i, j, libs, num, size: integer;
  s, other: bVal;
begin { findAtari }
  size := 0;
  s := board[xi, yi].val;
  if s = white then
    other := black
  else
    other := white;
  wipeMarks;
  libs := 0;
  spanGroup(s, xi, yi, libs, size);
  if libs = 1 then
    begin
      beep(atari);
      exit(findAtari);
    end;
  if xi > 0 then
    if (board[xi - 1, yi].val = other) and
       (not board[xi - 1, yi].marked) then
      begin
        wipeMarks;
        libs := 0;
        spanGroup(other, xi - 1, yi, libs, size);
        if libs = 1 then
          begin
            beep(atari);
            exit(findAtari);
          end;
      end;
  if xi < maxPoint then
    if (board[xi + 1, yi].val = other) and
       (not board[xi + 1, yi].marked) then
      begin
        wipeMarks;
        libs := 0;
        spanGroup(other, xi + 1, yi, libs, size);
        if libs = 1 then
          begin
            beep(atari);
            exit(findAtari);
          end;
      end;
  if yi > 0 then
    if (board[xi, yi - 1].val = other) and
       (not board[xi, yi - 1].marked) then
      begin
        wipeMarks;
        libs := 0;
        spanGroup(other, xi, yi - 1, libs, size);
        if libs = 1 then
          begin
            beep(atari);
            exit(findAtari);
          end;
      end;
  if yi < maxPoint then
    if (board[xi, yi + 1].val = other) and
       (not board[xi, yi + 1].marked) then
      begin
        wipeMarks;
        libs := 0;
        spanGroup(other, xi, yi + 1, libs, size);
        if libs = 1 then
          beep(atari);
      end;
end { findAtari };

procedure checkAtari(cm: pMRec);
begin { checkAtari }
  if cm <> treeRoot then
    if cm^.id <> hcPlay then
      if cm^.id <> pass then
        begin
          while cm^.id = remove do
            cm := cm^.blink;
          with cm^ do
            findAtari(mx, my);
      end;
end { checkAtari };

procedure restoreDead;
var
  i: integer;
  other: sType;
begin { restoreDead }
  for i := 1 to numEndDead do
    with endDead[i] do
      begin
        placeStone(whoDead, dx, dy, dox, doy, mn);
        if whoDead = white then
          other := black
        else
          other := white;
        captures[other] := captures[other] - 1;
      end;
  numEndDead := 0;
  gameOver := false;
end { restoreDead };

procedure backUp1;
var
  moveT: mType;
  prevMove, tm: pMRec;
begin { backUp1 }
  if dotSX >= 0 then
    begin
      dotStone(dotSX, dotSY);
      dotSX := -1;
    end;
  if gameOver then
    restoreDead;
  if curMove <> treeRoot then
    repeat
      with curMove^ do
        begin
          prevMove := blink;
          moveT := id;
          if id = move then
            remStone(mx, my)
          else if id = remove then
            begin
              placeStone(who, mx, my, ox, oy, moveN);
              if who = black then
                captures[white] := captures[white] - 1
              else
                captures[black] := captures[black] - 1;
            end
          else if id = pass then
            remPass
          else { hcPlay }
            clearBoard;
        end;
      curMove := prevMove;
   until (curMove = treeRoot) or (moveT = move) or (moveT = pass);
   if curMove = treeRoot then
     begin
       koX := -1;
       koY := -1;
       moveNum := 0;
     end
   else if curMove^.id = move then
     with curMove^ do
       begin
         koX := kx;
         koY := ky;
         moveNum := moveN;
       end
   else if curMove^.id = pass then
     with curMove^ do
       begin
         koX := -1;
         koY := -1;
         moveNum := moveN;
         showPass(who);
       end
   else if curMove^.id = hcPlay then
     begin
       koX := -1;
       koY := -1;
       moveNum := 1;
     end
   else
     begin
       tm := curMove^.blink;
       while tm^.id <> move do
         tm := tm^.blink;
       with tm^ do
         begin
           koX := kx;
           koY := ky;
           moveNum := moveN;
         end;
     end;
end { backUp1 };

procedure doMove(which: sType; ix, iy, pox, poy: integer);
var
  numDead: integer;
  cm: pMRec;
begin { doMove }
  if dotSX >= 0 then
    begin
      dotStone(dotSX, dotSY);
      dotSX := -1;
    end;
  if gameOver then
    restoreDead;
  curMove := newMove(curMove);
  moveNum := moveNum + 1;
  with curMove^ do
    begin
      mx := ix;
      my := iy;
      ox := pox;
      oy := poy;
      kx := koX;
      ky := koY;
      who := which;
      id := move;
      moveN := moveNum;
    end;
  curMove := mergeMove(curMove);
  cm := curMove;
  placeStone(which, ix, iy, pox, poy, moveNum);
  remDead(ix, iy, numDead);
  if libertyCount(ix, iy) < 1 then
    begin
      curMove := delBranch(curMove);
      moveNum := moveNum + 1;
      remStone(ix, iy);
      beep(error);
    end
  else
    begin
      captures[which] := captures[which] + numDead;
      if (numDead = 1) and (groupSize(ix, iy) = 1) then
        begin
          koX := killX;
          koY := killY;
        end
      else
        begin
          koX := -1;
          koY := -1;
        end;
      with cm^ do
        begin
          kx := koX;
          ky := koY;
        end;
    end;
end { doMove };

procedure doPass(which: sType);
begin { doPass }
  if dotSX >= 0 then
    begin
      dotStone(dotSX, dotSY);
      dotSX := -1;
    end;
  if gameOver then
    restoreDead;
  curMove := newMove(curMove);
  moveNum := moveNum + 1;
  with curMove^ do
    begin
      who := which;
      id := pass;
      moveN := moveNum;
    end;
  curMove := mergeMove(curMove);
  showPass(which);
end { doPass };

procedure doHCPlay(num: integer);
begin { doHCPlay }
  moveNum := 1;
  curMove := newMove(treeRoot);
  with curMove^ do
    begin
      who := black;
      id := hcPlay;
      hcNum := num;
    end;
  addHCStones(num);
end { doHCPlay };

procedure forwardTo(m: pMRec);
begin { forwardTo }
  if dotSX >= 0 then
    begin
      dotStone(dotSX, dotSY);
      dotSX := -1;
    end;
  curMove := m;
  if passShowing then
    remPass;
  with curMove^ do
    if id = hcPlay then
      begin
        addHCStones(hcNum);
        moveNum := 1;
      end
    else if id = pass then
      begin
        moveNum := moveN;
        koX := -1;
        koY := -1;
        showPass(who);
      end
    else
      begin
        moveNum := moveN;
        placeStone(who, mx, my, ox, oy, moveNum);
        koX := kx;
        koY := ky;
        while curMove^.flink <> nil do
          if curMove^.flink^.id = remove then
            begin
              curMove := curMove^.flink;
              with curMove^ do
                remStone(mx, my);
              if curMove^.who = white then
                captures[black] := captures[black] + 1
              else
                captures[white] := captures[white] + 1
            end
          else
            exit(forwardTo);
      end;
end { forwardTo };

procedure forwToBr;
var
  atBr: boolean;
begin { forwToBr }
  if dotSX >= 0 then
    begin
      dotStone(dotSX, dotSY);
      dotSX := -1;
    end;
  atBr := false;
  repeat
    if curMove^.flink = nil then
      atBr := true
    else if curMove^.flink^.slink <> nil then
      atBr := true
    else
      forwardTo(curMove^.flink);
  until atBr;
end { forwToBr };

procedure backToBr;
var
  na: integer;
  tm: pMRec;
  endLoop: boolean;
begin { backToBr }
  if dotSX >= 0 then
    begin
      dotStone(dotSX, dotSY);
      dotSX := -1;
    end;
  if curMove <> treeRoot then
    begin
      if not hasAlts(curMove) then
        repeat
          backUp1;
          if curMove = treeRoot then
            endLoop := true
          else
            endLoop := hasAlts(curMove);
        until endLoop;
      if curMove <> treeRoot then
        backUp1;
    end
  else
    beep(error);
end { backToBr };

function atBranch(cm: pMRec): boolean;
begin { atBranch }
  if cm^.flink <> nil then
    atBranch := cm^.flink^.slink <> nil
  else
    atBranch := false;
end { atBranch };

function atLeaf(cm: pMRec): boolean;
begin { atLeaf }
  atLeaf := cm^.flink = nil;
end { atLeaf };

procedure showAlts;
var
  tm: pMRec;
begin { showAlts }
  setMenuCursor;
  tm := curMove^.flink;
  passIsAlt := false;
  while tm <> nil do
    begin
      with tm^ do
        begin
          if id = move then
            placeAlt(who, mx, my, ox, oy)
          else if id = pass then
            begin
              SChrFunc(ord(rNot));
              showPass(who);
              SChrFunc(ord(rRpl));
              passIsAlt := true;
            end;
          tm := tm^.slink;
        end;
    end;
end { showAlts };

procedure remAlts;
var
  tm: pMRec;
begin { remAlts }
  tm := curMove^.flink;
  while tm <> nil do
    begin
      with tm^ do
        begin
          if id = move then
            remStone(mx, my)
          else if id = pass then
            remPass;
          tm := tm^.slink;
        end;
    end;
end { remAlts };

procedure selAlt(lx, ly: integer);
begin { selAlt }
  remAlts;
  curMove := curMove^.flink;
  repeat
    while curMove^.id <> move do
      curMove := curMove^.slink;
    if (curMove^.mx = lx) and (curMove^.my = ly) then
      begin
        forwardTo(curMove);
        exit(selAlt);
      end
    else
      curMove := curMove^.slink;
  until false;
end { selAlt };

procedure selPass;
begin { selPass }
  remAlts;
  curMove := curMove^.flink;
  while curMove^.id <> pass do
    curMove := curMove^.slink;
  forwardTo(curMove);
end { selPass };

procedure switchBranch(bm: pMRec);
var
  tm: pMRec;
begin { switchBranch }
  if dotSX >= 0 then
    begin
      dotStone(dotSX, dotSY);
      dotSX := -1;
    end;
  if gameOver then
    restoreDead;
  wipeTreeMarks;
  tm := bm;
  while tm <> treeRoot do
    begin
      tm^.mark := true;
      tm := tm^.blink;
    end;
  treeRoot^.mark := true;
  while not curMove^.mark do
    backup1;
  while curMove <> bm do
    begin
      tm := curMove^.flink;
      while not tm^.mark do
        tm := tm^.slink;
      forwardTo(tm);
    end;
end { switchBranch };

function stepTagPossible: boolean;
begin { stepTagPossible }
  if treeRoot^.lastTag = nil then
    stepTagPossible := false
  else if stepTag = nil then
    stepTagPossible := true
  else if curMove = treeRoot then
    stepTagPossible := true
  else if curMove^.tag = stepTag then
    stepTagPossible := false
  else
    stepTagPossible := true;
end { stepTagPossible };

procedure doStepTag;
var
  tm: pMRec;
begin { doStepTag }
  if stepTag = nil then
    exit(doStepTag);
  if dotSX >= 0 then
    begin
      dotStone(dotSX, dotSY);
      dotSX := -1;
    end;
  if gameOver then
    restoreDead;
  tm := stepTag^.mPtr;
  if curMove = tm then
    exit(doStepTag);
  wipeTreeMarks;
  while tm <> treeRoot do
    begin
      tm^.mark := true;
      tm := tm^.blink;
    end;
  treeRoot^.mark := true;
  if not curMove^.mark then
    begin
      prompt('Backed up to proper branch');
      repeat
        backup1;
      until curMove^.mark;
    end
  else
    begin
      tm := curMove^.flink;
      while not tm^.mark do
        tm := tm^.slink;
      forwardTo(tm);
    end;
end { doStepTag };

procedure scoreGame(var ws, bs: integer);
var
  i, j, size: integer;
  bSeen, wSeen: boolean;

  procedure spanEmpties(bx, by: integer);
  begin { spanEmpties }
    if (bx >= 0) and (bx <= maxPoint) and
       (by >= 0) and (by <= maxPoint) then
      begin
        if board[bx, by].val = white then
          wSeen := true
        else if board[bx, by].val = black then
          bSeen := true
        else if not board[bx, by].marked then
          begin
            board[bx, by].marked := true;
            size := size + 1;
            spanEmpties(bx - 1, by);
            spanEmpties(bx + 1, by);
            spanEmpties(bx, by - 1);
            spanEmpties(bx, by + 1);
          end;
      end;
  end { spanEmpties };

begin { scoreGame }
  ws := 0;
  bs := 0;
  wipeMarks;
  for j := 0 to maxPoint do
    for i := 0 to maxPoint do
      if (not board[i, j].marked) and
         (board[i, j].val = empty) then
        begin
          bSeen := false;
          wSeen := false;
          size := 0;
          spanEmpties(i, j);
          if bSeen and not wSeen then
            bs := bs + size
          else if wSeen and not bSeen then
            ws := ws + size;
        end;
end { scoreGame };

procedure putEnd;
begin { putEnd }
  if not gameOver then
    begin
      gameOver := true;
      numEndDead := 0;
    end;
end { putEnd };

procedure delGroup(bx, by: integer);
var
  sto, other: sType;
  size: integer;

  procedure dumpDead(bx, by: integer);
  begin { dumpDead }
    if (bx >= 0) and (bx <= maxPoint) and
       (by >= 0) and (by <= maxPoint) then
      if board[bx, by].val = sto then
        begin
          remStone(bx, by);
          numEndDead := numEndDead + 1;
          with endDead[numEndDead] do
            begin
              dx := bx;
              dy := by;
              with board[bx, by] do
                begin
                  dox := xOfs;
                  doy := yOfs;
                  mn := mNum;
                end;
              whoDead := sto;
            end;
          size := size + 1;
          dumpDead(bx - 1, by);
          dumpDead(bx + 1, by);
          dumpDead(bx, by - 1);
          dumpDead(bx, by + 1);
        end;
  end { dumpDead };

begin { delGroup }
  sto := board[bx, by].val;
  size := 0;
  dumpDead(bx, by);
  if sto = white then
    other := black
  else
    other := white;
  captures[other] := captures[other] + size;
end { delGroup };

procedure dotLast;
var
  tm: pMRec;
begin { dotLast }
  if numbEnabled then
    exit(dotLast);
  if dotSX >= 0 then
    dotStone(dotSX, dotSY);
  dotSX := -1;
  tm := curMove;
  while tm <> treeRoot do
    if tm^.id = pass then
      exit(dotLast)
    else if tm^.id = move then
      with tm^ do
        begin
          dotSX := mx;
          dotSY := my;
          dotStone(mx, my);
          exit(dotLast);
        end
    else
      tm := tm^.blink;
end { dotLast };

procedure initGoMgr;
begin { initGoMgr }
  moveNum := 0;
  curMove := treeRoot;
  gameOver := false;
  numEndDead := 0;
  dotSX := -1;
  dotSY := -1;
  passShowing := false;
end. { initGoMgr }
SHAR_EOF
fi
if test -f 'goPlayUtils.pas'
then
    echo shar: "will not over-write existing file 'goPlayUtils.pas'"
else
cat << \SHAR_EOF > 'goPlayUtils.pas'
module goPlayUtils;

exports

imports goCom from goCom;

const
  iNil = 32767; { a distinguished value like nil }
  maxGroup = 512;
  maxSPoint = 16;

type
  intBoard = array[-2..maxPoint + 2] of array[-2..maxPoint + 2] of integer;

  boolBoard = array[-2..maxPoint + 2] of array[-2..maxPoint + 2] of boolean;

  point = record
            px, py: integer;
          end;

  pointList = record
                p: array[1..400] of point;
                indx: integer;
              end;

  sPointList = record
                 p: array[1..maxSPoint] of point;
                 indx: integer;
               end;

  intList = record
              indx: integer;
              v: array[1..400] of integer;
            end;

  sgRec = record
            w, s, sm: integer;
          end;

  groupRec = record
               groupMark: integer;
               atLevel: integer;
               isLive: boolean;
               isDead: boolean;
               libC: integer;
               numEyes: integer;
               size: integer;
               lx, ly: integer;
             end;

var
  kleim, ekstre, bord, ndbord, sGroups, threatBord: intBoard;
  groupIDs, connectMap, protPoints: intBoard;
  groupSeen, legal: boolBoard;
  maxGroupID: integer;
  pList, pList1, plist2, plist3, pPlist: pointList;
  nlcGroup, aList: intList;
  sList: array[1..400] of sgRec;
  gList: array[0..maxGroup] of groupRec;
  killFlag: boolean;
  numCapt: integer;
  utilPlayLevel: integer;
  treeLibLim: integer;
  mySType: sType;
  showTrees: boolean;
  sGlist: array[1..maxGroup] of integer;
  depthLimit: integer;
  markBoard: intBoard;
  marker: integer;

function saveable(gx, gy: integer; var savex, savey: integer): boolean;
function killable(gx, gy: integer; var killx, killy: integer): boolean;
procedure initBoolBoard(var bb: boolBoard);
procedure spanGroup(x, y: integer; var libs: pointList);
function abs(i: integer): integer;
procedure intersectPlist(var p1, p2, pr: pointList);
procedure initArray(var ary: intBoard);
procedure initState;
procedure copyArray(var dAry, sAry: intBoard);
procedure steik;
procedure spread;
procedure respreicen;
procedure plei(x, y, z: integer);
procedure genState;
procedure saveState;
procedure restoreState;
function tencen(x, y: integer): integer;
procedure genConnects;
procedure initGPUtils;
procedure sortLibs;

private

imports screen from screen;
imports raster from raster;
imports goBoard from goBoard;
imports io_others from io_others;

type
  playType = (rem, add, chLib, reMap);

  playRec = record
              gID: integer;
              case kind: playType of
                rem, add:
                  (who, xl, yl, nextGID, sNumber: integer);
                chLib:
                  (oldLC, oldLevel: integer);
                reMap:
                  (oldGID: integer)
            end;

var
  adjInAtari, adj2Libs: boolean;
  intersectNum, spanNum, libMark: integer;
  playStack: array[1..1024] of playRec;
  playMark: integer;
  newGID: integer;
  tryLevel: integer;
  grpMark: integer;
  gMap: array[0..maxGroup] of integer;
  dbStop, inGenState: boolean;

exception screwup;

procedure pause;
begin { pause }
{  if dbStop and not inGenState then
    begin
      while not tabswitch do;
      repeat
        if tabYellow then
          dbStop := false;
      until not tabswitch;
    end;     }
end { pause };

procedure sstone(w, x, y, numb: integer);
var
  cx, cy: integer;
begin { sstone }
  sReadCursor(cx, cy);
  if w = 1 then
    placeStone(mySType, x, y, 0, 0, numb)
  else if mySType = white then
    placeStone(black, x, y, 0, 0, numb)
  else
    placeStone(white, x, y, 0, 0, numb);
  sSetCursor(cx, cy);
end { sstone };

procedure rstone(x, y: integer);
var
  cx, cy: integer;
begin { rstone }
  sReadCursor(cx, cy);
  remStone(x, y);
  sSetCursor(cx, cy);
end { rstone };

procedure initBoolBoard(var bb: boolBoard);
var
  i, j: integer;
begin { initBoolBoard }
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      bb[i, j] := false;
end { initBoolBoard };

function abs(i: integer): integer;
begin { abs }
  if i < 0 then
    abs := -i
  else
    abs := i;
end { abs };

procedure sortLibs;
var
  i, j, t: integer;
begin { sortLibs }
  for i := 1 to maxGroupID do
    sGList[i] := i;
  for i := 1 to maxGroupID - 1 do
    for j := i + 1 to maxGroupID do
      if gList[sGlist[i]].libC > gList[sGlist[j]].libC then
        begin
          t := sGList[i];
          sGlist[i] := sGlist[j];
          sGlist[j] := t;
        end;
end { sortLibs };

procedure spanGroup(x, y: integer; var libs: pointList);
var
  lookFor: integer;

  procedure span(x, y: integer);
  begin { span }
    markBoard[x, y] := marker;
    if bord[x, y] = 0 then
      begin
        libs.indx := libs.indx + 1;
        libs.p[libs.indx].px := x;
        libs.p[libs.indx].py := y;
      end
    else if bord[x, y] = lookFor then
      begin
        groupSeen[x, y] := true;
        if (x > 0) and (markBoard[x - 1, y] <> marker) then
          span(x - 1, y);
        if (y > 0) and (markBoard[x, y - 1] <> marker) then
          span(x, y - 1);
        if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
          span(x + 1, y);
        if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
          span(x, y + 1);
      end
    else if gList[gMap[groupIDs[x, y]]].libC = 1 then
      adjInAtari := true
    else if (gList[gMap[groupIDs[x, y]]].libC = 2) and
            (not gList[gMap[groupIDs[x, y]]].isLive) then
      adj2Libs := true;
  end { span };

begin { spanGroup }
  marker := marker + 1;
  if marker = 0 then
    begin
      initArray(markBoard);
      marker := 1;
    end;
  adjInAtari := false;
  adj2Libs := false;
  lookFor := bord[x, y];
  libs.indx := 0;
  span(x, y);
end { spanGroup };

procedure sSpanGroup(x, y: integer; var libs: sPointList);
var
  lookFor: integer;

  procedure span(x, y: integer);
  begin { span }
    markBoard[x, y] := marker;
    if bord[x, y] = 0 then
      begin
        libs.indx := libs.indx + 1;
        if libs.indx <= maxSPoint then
          begin
            libs.p[libs.indx].px := x;
            libs.p[libs.indx].py := y;
          end;
      end
    else if bord[x, y] = lookFor then
      begin
        groupSeen[x, y] := true;
        if (x > 0) and (markBoard[x - 1, y] <> marker) then
          span(x - 1, y);
        if (y > 0) and (markBoard[x, y - 1] <> marker) then
          span(x, y - 1);
        if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
          span(x + 1, y);
        if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
          span(x, y + 1);
      end
    else if gList[gMap[groupIDs[x, y]]].libC = 1 then
      adjInAtari := true
    else if (gList[gMap[groupIDs[x, y]]].libC = 2) and
            (not gList[gMap[groupIDs[x, y]]].isLive) then
      adj2Libs := true;
  end { span };

begin { sSpanGroup }
  marker := marker + 1;
  if marker = 0 then
    begin
      initArray(markBoard);
      marker := 1;
    end;
  adjInAtari := false;
  adj2Libs := false;
  lookFor := bord[x, y];
  libs.indx := 0;
  span(x, y);
end { sSpanGroup };

procedure listAdjacents(x, y: integer; var iL: intList);
var
  me, him: integer;

  procedure span(x, y: integer);
  begin { span }
    markBoard[x, y] := marker;
    if bord[x, y] = me then
      begin
        if (x > 0) and (markBoard[x - 1, y] <> marker) then
          span(x - 1, y);
        if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
          span(x + 1, y);
        if (y > 0) and (markBoard[x, y - 1] <> marker) then
          span(x, y - 1);
        if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
          span(x, y + 1);
      end
    else if bord[x, y] = him then
      if gList[gMap[groupIDs[x, y]]].groupMark <> grpMark then
        begin
          gList[gMap[groupIDs[x, y]]].groupMark := grpMark;
          iL.indx := iL.indx + 1;
          iL.v[iL.indx] := gMap[groupIDs[x, y]];
        end;
  end { span };

begin { listAdjacents }
  grpMark := grpMark + 1;
  marker := marker + 1;
  if marker = 0 then
    begin
      initArray(markBoard);
      marker := 1;
    end;
  iL.indx := 0;
  me := bord[x, y];
  him := -me;
  span(x, y);
end { listAdjacents };

procedure listDiags(x, y: integer; var diags: sPointList);
var
  me: integer;

  procedure span(x, y: integer);
  begin { span }
    markBoard[x, y] := marker;
    if (x > 0) and (y > 0) and
       (bord[x - 1, y - 1] = 0) and
       (bord[x, y - 1] <> me) and
       (bord[x - 1, y] <> me) and
       (markBoard[x - 1, y - 1] <> marker) then
      begin
        markBoard[x - 1, y - 1] := marker;
        diags.indx := diags.indx + 1;
        if diags.indx <= maxSPoint then
          with diags.p[diags.indx] do
            begin
              px := x - 1;
              py := y - 1;
            end;
      end;
    if (x < maxPoint) and (y > 0) and
       (bord[x + 1, y - 1] = 0) and
       (bord[x, y - 1] <> me) and
       (bord[x + 1, y] <> me) and
       (markBoard[x + 1, y - 1] <> marker) then
      begin
        markBoard[x + 1, y - 1] := marker;
        diags.indx := diags.indx + 1;
        if diags.indx <= maxSPoint then
          with diags.p[diags.indx] do
            begin
              px := x + 1;
              py := y - 1;
            end;
      end;
    if (x > 0) and (y < maxPoint) and
       (bord[x - 1, y + 1] = 0) and
       (bord[x, y + 1] <> me) and
       (bord[x - 1, y] <> me) and
       (markBoard[x - 1, y + 1] <> marker) then
      begin
        markBoard[x - 1, y + 1] := marker;
        diags.indx := diags.indx + 1;
        if diags.indx <= maxSPoint then
          with diags.p[diags.indx] do
            begin
              px := x - 1;
              py := y + 1;
            end;
      end;
    if (x < maxPoint) and (y < maxPoint) and
       (bord[x + 1, y + 1] = 0) and
       (bord[x, y + 1] <> me) and
       (bord[x + 1, y] <> me) and
       (markBoard[x + 1, y + 1] <> marker) then
      begin
        markBoard[x + 1, y + 1] := marker;
        diags.indx := diags.indx + 1;
        if diags.indx <= maxSPoint then
          with diags.p[diags.indx] do
            begin
              px := x + 1;
              py := y + 1;
            end;
      end;
    if (x > 0) and (bord[x - 1, y] = me) and
       (markBoard[x - 1, y] <> marker) then
      span(x - 1, y);
    if (x < maxPoint) and (bord[x + 1, y] = me) and
       (markBoard[x + 1, y] <> marker) then
      span(x + 1, y);
    if (y > 0) and (bord[x, y - 1] = me) and
       (markBoard[x, y - 1] <> marker) then
      span(x, y - 1);
    if (y < maxPoint) and (bord[x, y + 1] = me) and
       (markBoard[x, y + 1] <> marker) then
      span(x, y + 1);
  end { span };

begin { listDiags }
  me := bord[x, y];
  diags.indx := 0;
  marker := marker + 1;
  if marker = 0 then
    begin
      initArray(markBoard);
      marker := 1;
    end;
  span(x, y);
end { listDiags };

procedure intersectPlist(var p1, p2, pr: pointList);
var
  i, j, k: integer;
begin { intersectPlist }
  marker := marker + 1;
  if marker = 0 then
    begin
      initArray(markBoard);
      marker := 1;
    end;
  pr.indx := 0;
  for i := 1 to p1.indx do
    with p1.p[i] do
      markBoard[px, py] := marker;
  j := 0;
  for i := 1 to p2.indx do
    with p2.p[i] do
      if markBoard[px, py] = marker then
        begin
          j := j + 1;
          pr.p[j] := p2.p[i];
        end;
  pr.indx := j;
end { intersectPlist };

procedure initArray(var ary: intBoard);
var
  i, j: integer;
begin { initArray }
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      ary[i, j] := 0;
end { initArray };

procedure initState;
var
  i, j: integer;
begin { initState }
  for i := -2 to maxPoint + 2 do
    for j := -2 to maxPoint + 2 do
      begin
        ekstre[i, j] := 0;
        kleim[i, j] := 0;
        groupIDs[i, j] := 0;
        connectMap[i, j] := 0;
        protPoints[i, j] := 0;
      end;
end { initState };

procedure copyArray(var dAry, sAry: intBoard);
var
  i, j: integer;
begin { copyArray }
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      dAry[i, j] := sAry[i, j];
end { copyArray };

{
  generates a one-point spread in the force field array (kleim)

  the spread from a single point after four calls is:

              1
           2  2  2
        2  4  6  4  2
     2  4  8 10  8  4  2
  1  2  6 10 62 10  6  2  1
     2  4  8 10  8  4  2
        2  4  6  4  2
           2  2  2
              1

}
procedure steik;
var
  i, j: integer;
begin { steik }
  initArray(ekstre);
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      begin
        ekstre[i, j] := ekstre[i, j] + kleim[i, j];
        if kleim[i, j] > 0 then
          begin
            if i > 0 then
              ekstre[i - 1, j] := ekstre[i - 1, j] + 1;
            if j > 0 then
              ekstre[i, j - 1] := ekstre[i, j - 1] + 1;
            if i < maxPoint then
              ekstre[i + 1, j] := ekstre[i + 1, j] + 1;
            if j < maxPoint then
              ekstre[i, j + 1] := ekstre[i, j + 1] + 1;
          end
        else if kleim[i, j] < 0 then
          begin
            if i > 0 then
              ekstre[i - 1, j] := ekstre[i - 1, j] - 1;
            if j > 0 then
              ekstre[i, j - 1] := ekstre[i, j - 1] - 1;
            if i < maxPoint then
              ekstre[i + 1, j] := ekstre[i + 1, j] - 1;
            if j < maxPoint then
              ekstre[i, j + 1] := ekstre[i, j + 1] - 1;
          end;
      end;
  copyArray(kleim, ekstre);
end { steik };

{
  sets up kleim from the current board position
}
procedure spread;
var
  i, j: integer;
begin { spread }
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      kleim[i, j] := ndbord[i, j] * 50;
  steik;
  steik;
  steik;
  steik;
end { spread };

{
  gList is initialized with the size, loc, and libCount of each group
  groupIDs contains the serial numbers of the groups.
}
procedure respreicen;
var
  i, j, gID, libCount, gSize, who: integer;

  procedure span(x, y: integer);
  begin { span }
    if (bord[x, y] = 0) and
       (markBoard[x, y] <> marker) then { a liberty }
      begin
        markBoard[x, y] := marker;
        libCount := libCount + 1;
      end
    else if (bord[x, y] = who) and
            (groupIDs[x, y] = 0) then
      begin
        groupIDs[x, y] := gID;
        gSize := gSize + 1;
        if x > 0 then
          span(x - 1, y);
        if x < maxPoint then
          span(x + 1, y);
        if y > 0 then
          span(x, y - 1);
        if y < maxPoint then
          span(x, y + 1);
      end;
  end { span };

begin { respreicen }
  gID := 0;
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      groupIDs[i, j] := 0;
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      if (bord[i, j] <> 0) and   { a stone there }
         (groupIDs[i, j] = 0) then { not seen yet }
        begin
          marker := marker + 1;
          if marker = 0 then
            begin
              initArray(markBoard);
              marker := 1;
            end;
          gID := gID + 1;
          libCount := 0;
          gSize := 0;
          who := bord[i, j];
          span(i, j); { span the group, collecting info }
          with gList[gID] do
            begin
              groupMark := 0;
              atLevel := 0;
              isLive := false; { we don't know yet }
              isDead := false;
              numEyes := -1;
              size := gSize;
              libC := libCount;
              lx := i;
              ly := j;
            end;
          gMap[gID] := gID; { set up identity map }
        end;
  maxGroupID := gID;
  newGID := gID;
  grpMark := 0;
end { respreicen };

{
  play z at [x, y].
  killFlag is set true if anything is killed.
}
procedure plei(x, y, z: integer);
var
  i, me, him, myGID: integer;
  isNew: boolean;

  procedure killGroup(x, y: integer);
  begin { killGroup }
    playMark := playMark + 1;
    with playStack[playMark] do
      begin                        { record this kill }
        kind := rem;
        who := him;
        xl := x;
        yl := y;
        gID := groupIDs[x, y];
        sNumber := board[x, y].mNum;
        if showTrees then
          rstone(x, y);
      end;
    numCapt := numCapt + 1;
    bord[x, y] := 0;
    groupIDs[x, y] := 0;
    if x > 0 then
      begin
        if bord[x - 1, y] = me then
          begin
            nlcGroup.indx := nlcGroup.indx + 1;
            nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x - 1, y]];
          end
        else if bord[x - 1, y] = him then
          killGroup(x - 1, y);
      end;
    if x < maxPoint then
      begin
        if bord[x + 1, y] = me then
          begin
            nlcGroup.indx := nlcGroup.indx + 1;
            nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x + 1, y]];
          end
        else if bord[x + 1, y] = him then
          killGroup(x + 1, y);
      end;
    if y > 0 then
      begin
        if bord[x, y - 1] = me then
          begin
            nlcGroup.indx := nlcGroup.indx + 1;
            nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y - 1]];
          end
        else if bord[x, y - 1] = him then
          killGroup(x, y - 1);
      end;
    if y < maxPoint then
      begin
        if bord[x, y + 1] = me then
          begin
            nlcGroup.indx := nlcGroup.indx + 1;
            nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y + 1]];
          end
        else if bord[x, y + 1] = him then
          killGroup(x, y + 1);
      end;
  end { killGroup };

  procedure mergeGroup(sGID: integer);
  var
    i: integer;
  begin { mergeGroup }
    for i := 1 to newGID do
      if gMap[i] = sGID then
        begin
          playMark := playMark + 1;
          with playStack[playMark] do
            begin
              kind := reMap;
              gID := i;
              oldGID := sGID;
            end;
          gMap[i] := myGID;
        end;
  end { mergeGroup };

begin { plei }
  me := z;
  him := -me;
  killFlag := false;  { set true if something is killed }
  numCapt := 0;
  tryLevel := tryLevel + 1;
  isNew := false;
  bord[x, y] := z;  { play the stone }
  if (x > 0) and (bord[x - 1, y] = me) then   { connect to adjacent group }
    myGID := gMap[groupIDs[x - 1, y]]
  else if (x < maxPoint) and (bord[x + 1, y] = me) then
    myGID := gMap[groupIDs[x + 1, y]]
  else if (y > 0) and (bord[x, y - 1] = me) then
    myGID := gMap[groupIDs[x, y - 1]]
  else if (y < maxPoint) and (bord[x, y + 1] = me) then
    myGID := gMap[groupIDs[x, y + 1]]
  else  { nobody to connect to }
    begin
      newGID := newGID + 1;
      isNew := true;
      myGID := newGID;
      with gList[myGID] do
        begin
          groupMark := 0;
          atLevel := tryLevel;
          isLive := false;
          numEyes := -1;
          size := -1;
          lx := x;
          ly := y;
        end;
      gMap[myGID] := myGID;
    end;
  groupIDs[x, y] := myGID;
  playMark := playMark + 1;
  with playStack[playMark] do
    begin                        { record this move }
      kind := add;
      who := me;
      xl := x;
      yl := y;
      gID := myGID;
      sNumber := 0;
      if isNew then
        nextGID := newGID - 1
      else
        nextGID := newGID;
      if showTrees then
        sstone(me, x, y, 0);
    end;
  { merge adjacent groups }
  if (x > 0) and (bord[x - 1, y] = me) and
     (gMap[groupIDs[x - 1, y]] <> myGID) then
    mergeGroup(gMap[groupIDs[x - 1, y]]);
  if (x < maxPoint) and (bord[x + 1, y] = me) and
     (gMap[groupIDs[x + 1, y]] <> myGID) then
    mergeGroup(gMap[groupIDs[x + 1, y]]);
  if (y > 0) and (bord[x, y - 1] = me) and
     (gMap[groupIDs[x, y - 1]] <> myGID) then
    mergeGroup(gMap[groupIDs[x, y - 1]]);
  if (y < maxPoint) and (bord[x, y + 1] = me) and
     (gMap[groupIDs[x, y + 1]] <> myGID) then
    mergeGroup(gMap[groupIDs[x, y + 1]]);
  { kill opposing groups, listing affected groups }
  nlcGroup.indx := 1;
  nlcGroup.v[1] := myGID; { init list to include me }
  if (x > 0) and (bord[x - 1, y] = him) and
     (gList[gMap[groupIDs[x - 1, y]]].libC = 1) then
    begin
      killFlag := true;
      killGroup(x - 1, y);
    end;
  if (x < maxPoint) and (bord[x + 1, y] = him) and
     (gList[gMap[groupIDs[x + 1, y]]].libC = 1) then
    begin
      killFlag := true;
      killGroup(x + 1, y);
    end;
  if (y > 0) and (bord[x, y - 1] = him) and
     (gList[gMap[groupIDs[x, y - 1]]].libC = 1) then
    begin
      killFlag := true;
      killGroup(x, y - 1);
    end;
  if (y < maxPoint) and (bord[x, y + 1] = him) and
     (gList[gMap[groupIDs[x, y + 1]]].libC = 1) then
    begin
      killFlag := true;
      killGroup(x, y + 1);
    end;
  { list groups adjacent to me }
  if (x > 0) and (bord[x - 1, y] = him) then
    begin
      nlcGroup.indx := nlcGroup.indx + 1;
      nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x - 1, y]];
    end;
  if (x < maxPoint) and (bord[x + 1, y] = him) then
    begin
      nlcGroup.indx := nlcGroup.indx + 1;
      nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x + 1, y]];
    end;
  if (y > 0) and (bord[x, y - 1] = him) then
    begin
      nlcGroup.indx := nlcGroup.indx + 1;
      nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y - 1]];
    end;
  if (y < maxPoint) and (bord[x, y + 1] = him) then
    begin
      nlcGroup.indx := nlcGroup.indx + 1;
      nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y + 1]];
    end;
  { fix liberty count for affected groups }
  grpMark := grpMark + 1;
  for i := 1 to nlcGroup.indx do
    with gList[nlcGroup.v[i]] do
      if groupMark <> grpMark then
        begin
          if atLevel <> tryLevel then
            begin
              playMark := playMark + 1;
              with playStack[playMark] do
                begin
                  kind := chLib;
                  gID := nlcGroup.v[i];
                  oldLevel := atLevel;
                  oldLC := libC;
                end;
            end;
          groupMark := grpMark;
          atLevel := tryLevel;
          spanGroup(lx, ly, pPList);
          libC := pPList.indx;
        end;
end { plei };

procedure saveState;
begin { saveState };
  playMark := 0;
  tryLevel := 0;
  newGID := maxGroupID;
end { saveState };

{
  undoes a move sequence back to uMark
}
procedure undoTo(uMark: integer);
var
  i: integer;
begin { undoTo }
  for i := playMark downto uMark + 1 do
    with playStack[i] do
      if kind = rem then
        begin
          bord[xl, yl] := who;
          groupIDs[xl, yl] := gID;
          if showTrees then
            sstone(who, xl, yl, sNumber);
        end
      else if kind = add then
        begin
          bord[xl, yl] := 0;
          groupIDs[xl, yl] := 0;
          tryLevel := tryLevel - 1;
          newGID := nextGID;
          if showTrees then
            rstone(xl, yl);
        end
      else if kind = reMap then
        gMap[gID] := oldGID
      else { change libs of group - gID is pre-mapped }
        with gList[gID] do
          begin
            libC := oldLC;
            atLevel := oldLevel;
          end;
  playMark := uMark;
end { undoTo };

{
  restores the state of the world after trying a move sequence
}
procedure restoreState;
var
  i: integer;
begin { restoreState }
  if playMark > 0 then
    begin
      undoTo(0);
      playMark := 0;
      tryLevel := 0;
    end;
end { restoreState };

exception bpt;

{
  returns true if the group (at x, y) is killable.
  if so, returns the point to play at in killx, killy.
}
function killable(gx, gy: integer; var killx, killy: integer): boolean;
const
  tryLimit = 300;

var
  me, him, depth, i, j, tryCount, tl, topMark, tkMark, mark2: integer;
  sChar: char;
  lList, dList: sPointList;
  tp: point;
  libList: array[1..maxSPoint] of integer;
  esc: boolean;

  function mtNbrs(x, y: integer): integer;
  var
    n: integer;
  begin { mtNbrs }
    n := 0;
    if (x > 0) and (bord[x - 1, y] = 0) then
      n := n + 1;
    if (x < maxPoint) and (bord[x + 1, y] = 0) then
      n := n + 1;
    if (y > 0) and (bord[x, y - 1] = 0) then
      n := n + 1;
    if (y < maxPoint) and (bord[x, y + 1] = 0) then
      n := n + 1;
    mtNbrs := n;
  end { mtNbrs };

  function tKillTree(tx, ty: integer): boolean;
  var
    tkMark: integer;
    escape: boolean;

  function killTree(tx, ty: integer; var escape: boolean): boolean;
    label
      1, 2;
    var
      curMark, mark2, mark3, i, j, k, tl, dStart: integer;
      lList1, lList2: sPointList;
      libList: array[1..maxSPoint] of integer;
      tp: point;
      esc: boolean;
    begin { killTree }
      escape := false;
      tryCount := tryCount + 1;
      if tryCount > tryLimit then
        begin
          killable := false;
          undoTo(tkMark);
          for i := 1 to depth - 1 do
            begin
              sClearChar(sChar, rXor);
            end;
          depth := 1;
          exit(tKilltree);
        end;
      write(sChar);
      depth := depth + 1;
      curMark := playMark;
      plei(tx, ty, me); { try my move }
      pause;
      if gList[gMap[groupIDs[tx, ty]]].libC = 0 then { I'm dead }
        killTree := false
      else if killFlag then { I killed something of his }
        killTree := true
      else if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then { safe }
        killTree := false
      else
        begin
          sSpanGroup(gx, gy, lList1); { find his liberties }
          if gList[gMap[groupIDs[tx, ty]]].libC = 1 then { he can kill me }
            begin
              if lList1.indx < maxSPoint then { add that option to his list }
                begin
                  lList1.indx := lList1.indx + 1;
                  spanGroup(tx, ty, pList2); { find my liberty }
                  with lList1.p[lList1.indx] do
                    begin
                      px := pList2.p[1].px;
                      py := pList2.p[1].py;
                    end;
                end
              else
                begin
                  killTree := false; { forget it }
                  goto 1;
                end;
            end;
          for i := 1 to maxSPoint do    { init liblist so diags can be marked }
            libList[i] := -1;
          if (utilPlayLevel > 4) and
             (lList1.indx > 1) and
             (gList[gMap[groupIDs[gx, gy]]].libC > 1) then { try diags }
            begin
              listDiags(gx, gy, dList);
              j := 0;
              i := lList1.indx;
              while (j < dList.indx) and
                    (i < maxSPoint) do
                begin
                  j := j + 1;
                  i := i + 1;
                  libList[i] := 0;     { mark this as a diag }
                  with dList.p[j] do
                    begin
                      lList1.p[i].px := px;
                      lList1.p[i].py := py;
                    end;
                end;
              lList1.indx := i;
            end;
          if lList1.indx > 1 then { sort by decreasing lib count }
            begin
              for i := 1 to lList1.indx do
                if libList[i] <> 0 then       { diags are tried last }
                  with lList1.p[i] do
                    begin
                      mark2 := playMark;
                      plei(px, py, him);
                      libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
                      if (libList[i] > treeLibLim) or
                         ((libList[i] > (depthLimit - depth)) and
                          (libList[i] > 2)) then
                        begin
                          escape := true;
                          killTree := false;
                          goto 1; { he can live }
                        end;
                      undoTo(mark2);
                    end;
              for i := 1 to lList1.indx - 1 do
                for j := i + 1 to lList1.indx do
                  if libList[i] < libList[j] then
                    begin
                      tl := libList[i];
                      libList[i] := libList[j];
                      libList[j] := tl;
                      tp := lList1.p[i];
                      lList1.p[i] := lList1.p[j];
                      lList1.p[j] := tp;
                    end;
            end;
          for i := 1 to lList1.indx + 1 do { try his responses }
            begin
              mark2 := playMark;
              if i <= lList1.indx then { try his move }
                with lList1.p[i] do
                  begin
                    plei(px, py, him); { play his response }
                    pause;
                    if gList[gMap[groupIDs[px, py]]].libC < 2 then
                      goto 2; { a bogus move }
                  end
              else if gList[gMap[groupIDs[gx, gy]]].libC <= 1 then
                begin
                  killTree := true; { can't tenuki if in atari }
                  goto 1;
                end;
              if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then
                begin
                  escape := true;
                  killTree := false;
                  goto 1;
                end;
              if gList[gMap[groupIDs[gx, gy]]].libC > 1 then
                begin  { look at my responses }
                  sSpanGroup(gx, gy, lList2); { list his liberties }
                  dStart := lList2.indx + 1;
                  if adjInAtari then { he wins }
                     begin
                       killTree := false;
                       goto 1;
                     end;
                  if (lList2.Indx > 2) and adj2Libs then { he wins }
                     begin
                       killTree := false;
                       goto 1;
                     end;
                  for k := 1 to maxSPoint do
                    libList[k] := -1;
                  if utilPlayLevel > 4 then { account for diagonal moves }
                    begin
                      listDiags(gx, gy, dList);
                      j := 0;
                      k := lList2.indx;
                      while (j < dList.indx) and
                            (k < maxSPoint) do
                        begin
                          j := j + 1;
                          k := k + 1;
                          libList[k] := 100;
                          with dList.p[j] do
                            begin
                              lList2.p[k].px := px;
                              lList2.p[k].py := py;
                            end;
                        end;
                      lList2.indx := k;
                    end;
                  if lList2.indx > 1 then { sort by increasing lib count }
                    begin
                      for k := 1 to lList2.indx do
                        if libList[k] <> 100 then     { diags go last }
                          with lList2.p[k] do
                            begin
                              mark3 := playMark;
                              plei(px, py, me);
                              libList[k] := gList[gMap[groupIDs[gx, gy]]].libC;
                              undoTo(mark3);
                            end;
                      for k := 1 to lList2.indx - 1 do
                        for j := k + 1 to lList2.indx do
                          if libList[k] > libList[j] then
                            begin
                              tl := libList[k];
                              libList[k] := libList[j];
                              libList[j] := tl;
                              tp := lList2.p[k];
                              lList2.p[k] := lList2.p[j];
                              lList2.p[j] := tp;
                            end
                          else if (libList[k] = libList[j]) and
                                  (libList[k] = 1) then
                            if mtNbrs(lList2.p[k].px, lList2.p[k].py) <
                               mtNbrs(lList2.p[j].px, lList2.p[j].py) then
                              begin
                                tl := libList[k];
                                libList[k] := libList[j];
                                libList[j] := tl;
                                tp := lList2.p[k];
                                lList2.p[k] := lList2.p[j];
                                lList2.p[j] := tp;
                              end;
                    end;
                  for j := 1 to lList2.indx do
                    begin
                      if killTree(lList2.p[j].px, lList2.p[j].py, esc) then
                        goto 2; { this kills him }
                      if esc and (j >= dStart) then
                        begin
                          killTree := false;
                          goto 1; { don't bother with more diags if escapes }
                        end;
                    end;
                  killTree := false;  { none of my responses kills him }
                  goto 1;
                end;
    2:
             undoTo(mark2);
           end;
          killTree := true; { none of his responses saves him }
        end;
    1:
      undoTo(curMark);
      sClearChar(sChar, rXor);
      depth := depth - 1;
    end { killTree };

  begin { tKillTree }
    tryCount := 0;
    tkMark := playMark;
    tKillTree := killTree(tx, ty, escape);
  end { tKillTree };

begin { killable }
  dbStop := true;
  him := bord[gx, gy]; { find out who I am }
  me := -him;
  if me = 1 then
    sChar := '>'
  else
    sChar := '|';
  write(sChar);
  depth := 1;
  topMark := playMark;
  sSpanGroup(gx, gy, lList); { find his liberties }
  if lList.indx = 1 then
    begin
      killable := true;
      killx := lList.p[1].px;
      killy := lList.p[1].py;
    end
  else if lList.indx > treeLibLim then
    killable := false
  else if adjInAtari then
    killable := false
  else if (lList.indx > 2) and adj2Libs then
    killable := false
  else
    begin
      for i := 1 to maxSPoint do
        libList[i] := -1;
      if utilPlayLevel > 4 then { account for diagonal moves }
        begin
          listDiags(gx, gy, dList);
          j := 0;
          i := lList.indx;
          while (j < dList.indx) and
                (i < maxSPoint) do
            begin
              j := j + 1;
              i := i + 1;
              libList[i] := 100;
              with dList.p[j] do
                begin
                  lList.p[i].px := px;
                  lList.p[i].py := py;
                end;
            end;
          lList.indx := i;
        end;
      if lList.indx > 1 then { sort by increasing lib count }
        begin
          for i := 1 to lList.indx do
            if libList[i] <> 100 then  { diags go last }
              with lList.p[i] do
                begin
                  mark2 := playMark;
                  plei(px, py, me);
                  libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
                  undoTo(mark2);
                end;
          for i := 1 to lList.indx - 1 do
            for j := i + 1 to lList.indx do
              if libList[i] > libList[j] then
                begin
                  tl := libList[i];
                  libList[i] := libList[j];
                  libList[j] := tl;
                  tp := lList.p[i];
                  lList.p[i] := lList.p[j];
                  lList.p[j] := tp;
                end
              else if (libList[i] = libList[j]) and
                      (libList[i] = 1) then
                if mtNbrs(lList.p[i].px, lList.p[i].py) <
                   mtNbrs(lList.p[j].px, lList.p[j].py) then
                  begin
                    tl := libList[i];
                    libList[i] := libList[j];
                    libList[j] := tl;
                    tp := lList.p[i];
                    lList.p[i] := lList.p[j];
                    lList.p[j] := tp;
                  end;
        end;
      for i := 1 to lList.indx do
        begin
          if legal[lList.p[i].px, lList.p[i].py] then
            begin
              killx := lList.p[i].px;
              killy := lList.p[i].py;
              if tKillTree(killx, killy) then
                begin
                  killable := true;
                  sClearChar(sChar, rXor);
                  exit(killable);
                end;
            end;
        end;
      killable := false;
    end;
  sClearChar(sChar, rXor);
end { killable };

{
  returns true if the group (at gx, gy) is saveable.
  if so, returns the point to play at in savex, savey
}
function saveable(gx, gy: integer; var savex, savey: integer): boolean;
label
  1;
var
  me, him, gx1, gx2, i, j, smark, mark2, tl: integer;
  sChar: char;
  dList: sPointList;
  tp: point;
  libList: array[1..maxSPoint] of integer;
begin { saveable }
  dbStop := true;
  me := bord[gx, gy];
  him := -me;
  if me = 1 then
    sChar := '|'
  else
    sChar := '>';
  write(sChar);
  spanGroup(gx, gy, pList3); { find my liberties }
  if adjInAtari then { one of my options is to kill }
    begin
      listAdjacents(gx, gy, aList);
      for i := 1 to aList.indx do
        if gList[aList.v[i]].libC = 1 then
          with gList[aList.v[i]] do
            begin
              spanGroup(lx, ly, pList1); { find it's liberty }
              pList3.indx := pList3.indx + 1;
              pList3.p[pList3.indx].px := pList1.p[1].px;
              pList3.p[pList3.indx].py := pList1.p[1].py;
            end;
    end;
  for i := 1 to maxSPoint do
    libList[i] := -1;
  if (utilPlayLevel > 4) and
     (gList[gMap[groupIDs[gx, gy]]].libC > 1) then { account for diags }
    begin
      listDiags(gx, gy, dList);
      j := 0;
      i := pList3.indx;
      while (j < dList.indx) and
            (i < maxSPoint) do
        begin
          j := j + 1;
          i := i + 1;
          libList[i] := 100;
          with dList.p[j] do
            begin
              pList3.p[i].px := px;
              pList3.p[i].py := py;
            end;
        end;
      pList3.indx := i;
    end;
  if pList3.indx > 1 then { sort by decreasing lib count }
    begin
      for i := 1 to pList3.indx do
        if libList[i] <> 100 then
          with pList3.p[i] do
            begin
              mark2 := playMark;
              plei(px, py, me);
              libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
              if libList[i] > treeLibLim then { i'm safe }
                begin
                  savex := px;
                  savey := py;
                  saveable := true;
                  goto 1;
                end;
              undoTo(mark2);
            end;
      for i := 1 to pList3.indx - 1 do
        for j := i + 1 to pList3.indx do
          if libList[i] < libList[j] then
            begin
              tl := libList[i];
              libList[i] := libList[j];
              libList[j] := tl;
              tp := pList3.p[i];
              pList3.p[i] := pList3.p[j];
              pList3.p[j] := tp;
            end;
    end;
  for i := 1 to pList3.indx do
    begin
      savex := pList3.p[i].px;
      savey := pList3.p[i].py;
      if legal[savex, savey] then
        begin
          smark := playMark;
          plei(savex, savey, me);
          pause;
          if gList[gMap[groupIDs[savex, savey]]].libC > 1 then
            if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then
              begin
                saveable := true;
                restoreState;
                sClearChar(sChar, rXor);
                exit(saveable);
              end
            else if gList[gMap[groupIDs[gx, gy]]].libC > 1 then
              if not killable(gx, gy, gx1, gx2) then
                begin
                  saveable := true;
                  restoreState;
                  sClearChar(sChar, rXor);
                  exit(saveable);
                end;
          undoTo(smark);
        end;
    end;
  saveable := false;
1:
  restoreState;
  sClearChar(sChar, rXor);
end { saveable };

{
  marks unsavable groups as dead
}
procedure markDead;
var
  i, j, gx, gy: integer;
begin { markDead }
  for i := 1 to maxGroupID do
    with gList[i] do
      if killable(lx, ly, gx, gy) then
        isDead := not saveable(lx, ly, gx, gy)
      else
        isDead := false;
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      if bord[i, j] = 0 then
        ndbord[i, j] := 0
      else if gList[groupIDs[i, j]].isDead then
        ndbord[i, j] := 0
      else
        ndbord[i, j] := bord[i, j];
end { markDead };

{
  marks groups with two eyes as live
}
procedure markLive;
var
  i, j, size, sMark: integer;
  saw1, sawm1: boolean;

  procedure span(x, y: integer);
  begin { span }
    if ndbord[x, y] = 1 then
      saw1 := true
    else if ndbord[x, y] = -1 then
      sawm1 := true
    else if sGroups[x, y] = 0 then
      begin
        sGroups[x, y] := sMark;
        size := size + 1;
        if x > 0 then
          span(x - 1, y);
        if x < maxPoint then
          span(x + 1, y);
        if y > 0 then
          span(x, y - 1);
        if y < maxPoint then
          span(x, y + 1);
      end;
  end { span };

  function checkLive(x, y: integer): boolean;
  var
    numEyes, who: integer;

    procedure span(x, y: integer);
    begin { span }
      markBoard[x, y] := marker;
      if ndbord[x, y] = 0 then
        with sList[sGroups[x, y]] do
          begin
            if (sm <> marker) and
               (w = who) then
              begin
                sm := marker;
                if s > 6 then
                  exit(checkLive);
                numEyes := numEyes + 1;
                if numEyes > 1 then
                  exit(checkLive);
              end;
          end
      else if bord[x, y] = who then
        begin
          if (x > 0) and
             (markBoard[x - 1, y] <> marker) then
            span(x - 1, y);
          if (x < maxPoint) and
             (markBoard[x + 1, y] <> marker) then
            span(x + 1, y);
          if (y > 0) and
             (markBoard[x, y - 1] <> marker) then
            span(x, y - 1);
          if (y < maxPoint) and
             (markBoard[x, y + 1] <> marker) then
            span(x, y + 1);
        end;
    end { span };

  begin { checkLive }
    checkLive := true;
    numEyes := 0;
    who := bord[x, y];
    marker := marker + 1;
    span(x, y);
    checkLive := false;
  end { checkLive };

begin { markLive }
  sMark := 0;
  initArray(sGroups);
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      if (sGroups[i, j] = 0) and
         (ndbord[i, j] = 0) then
        begin
          size := 0;
          sMark := sMark + 1;
          sawm1 := false;
          saw1 := false;
          span(i, j);
          sList[sMark].s := size;
          sList[sMark].sm := 0;
          if sawm1 then
            if saw1 then
              sList[sMark].w := 0
            else
              sList[sMark].w := -1
          else if saw1 then
            sList[sMark].w := 1
          else
            sList[sMark].w := 0;
        end;
  for i := 1 to maxGroupID do
    with gList[i] do
      if not isDead then
        isLive := checkLive(lx, ly);
end { markLive };

{
  generates the connection map and the protected point map.
}
procedure genConnects;
var
  x, y, numStones: integer;
begin { genConnects }
  for x := 0 to maxPoint do
    for y := 0 to maxPoint do
      begin
        connectMap[x, y] := 0;
        protPoints[x, y] := 0;
      end;
  for x := 0 to maxPoint do
    for y := 0 to maxPoint do
      if bord[x, y] = 1 then   { map connections to this stone }
        begin
          if x > 0 then        { direct connection }
            connectMap[x - 1, y] := connectMap[x - 1, y] + 1;
          if x < maxPoint then
            connectMap[x + 1, y] := connectMap[x + 1, y] + 1;
          if y > 0 then
            connectMap[x, y - 1] := connectMap[x, y - 1] + 1;
          if y < maxPoint then
            connectMap[x, y + 1] := connectMap[x, y + 1] + 1;
          if (x > 0) and (y > 0) and   { diagonal connection }
             (bord[x - 1, y] = 0) and (bord[x, y - 1] = 0) then
            connectMap[x - 1, y - 1] := connectMap[x - 1, y - 1] + 1;
          if (x < maxPoint) and (y > 0) and
             (bord[x + 1, y] = 0) and (bord[x, y - 1] = 0) then
            connectMap[x + 1, y - 1] := connectMap[x + 1, y - 1] + 1;
          if (x < maxPoint) and (y < maxPoint) and
             (bord[x + 1, y] = 0) and (bord[x, y + 1] = 0) then
            connectMap[x + 1, y + 1] := connectMap[x + 1, y + 1] + 1;
          if (x > 0) and (y < maxPoint) and
             (bord[x - 1, y] = 0) and (bord[x, y + 1] = 0) then
            connectMap[x - 1, y + 1] := connectMap[x - 1, y + 1] + 1;
          if (x > 1) and (kleim[x - 1, y] > 3) then   { one point jump }
            connectMap[x - 2, y] := connectMap[x - 2, y] + 1;
          if (x < (maxPoint - 1)) and (kleim[x + 1, y] > 3) then
            connectMap[x + 2, y] := connectMap[x + 2, y] + 1;
          if (y > 1) and (kleim[x, y - 1] > 3) then
            connectMap[x, y - 2] := connectMap[x, y - 2] + 1;
          if (y < (maxPoint - 1)) and (kleim[x, y + 1] > 3) then
            connectMap[x, y + 2] := connectMap[x, y + 2] + 1;
          if (x > 1) and (y > 0) and        { knight's move }
             (kleim[x - 1, y] > 3) and (kleim[x - 1, y - 1] > 3) then
            connectMap[x - 2, y - 1] := connectMap[x - 2, y - 1] + 1;
          if (x > 0) and (y > 1) and
             (kleim[x, y - 1] > 3) and (kleim[x - 1, y - 1] > 3) then
            connectMap[x - 1, y - 2] := connectMap[x - 1, y - 2] + 1;
          if (x < (maxPoint - 1)) and (y > 0) and
             (kleim[x + 1, y] > 3) and (kleim[x + 1, y - 1] > 3) then
            connectMap[x + 2, y - 1] := connectMap[x + 2, y - 1] + 1;
          if (x < maxPoint) and (y > 1) and
             (kleim[x, y - 1] > 3) and (kleim[x + 1, y - 1] > 3) then
            connectMap[x + 1, y - 2] := connectMap[x + 1, y - 2] + 1;
          if (x > 1) and (y < maxPoint) and
             (kleim[x - 1, y] > 3) and (kleim[x - 1, y + 1] > 3) then
            connectMap[x - 2, y + 1] := connectMap[x - 2, y + 1] + 1;
          if (x > 0) and (y < (maxPoint - 1)) and
             (kleim[x, y + 1] > 3) and (kleim[x - 1, y + 1] > 3) then
            connectMap[x - 1, y + 2] := connectMap[x - 1, y + 2] + 1;
          if (x < (maxPoint - 1)) and (y < maxPoint) and
             (kleim[x + 1, y] > 3) and (kleim[x + 1, y + 1] > 3) then
            connectMap[x + 2, y + 1] := connectMap[x + 2, y + 1] + 1;
          if (x < maxPoint) and (y < (maxPoint - 1)) and
             (kleim[x, y + 1] > 3) and (kleim[x + 1, y + 1] > 3) then
            connectMap[x + 1, y + 2] := connectMap[x + 1, y + 2] + 1;
        end
      else if bord[x, y] = 0 then { see if protected point }
        begin
          numStones := 0;
          if x = 0 then
            numStones := numStones + 1;
          if y = 0 then
            numStones := numStones + 1;
          if x = maxPoint then
            numStones := numStones + 1;
          if y = maxPoint then
            numStones := numStones + 1;
          if (x > 0) and (bord[x - 1, y] = 1) then
            numStones := numStones + 1;
          if (y > 0) and (bord[x, y - 1] = 1) then
            numStones := numStones + 1;
          if (x < maxPoint) and (bord[x + 1, y] = 1) then
            numStones := numStones + 1;
          if (y < maxPoint) and (bord[x, y + 1] = 1) then
            numStones := numStones + 1;
          if numStones = 4 then
            protPoints[x, y] := 1
          else if numStones = 3 then
            begin
              if (x > 0) and
                 ((bord[x - 1, y] = 0) or
                  ((bord[x - 1, y] = -1) and
                   (gList[groupIDs[x - 1, y]].libC = 1))) then
                 protPoints[x, y] := 1
              else if (x < maxPoint) and
                      ((bord[x + 1, y] = 0) or
                       ((bord[x + 1, y] = -1) and
                        (gList[groupIDs[x + 1, y]].libC = 1))) then
                 protPoints[x, y] := 1
              else if (y > 0) and
                      ((bord[x, y - 1] = 0) or
                       ((bord[x, y - 1] = -1) and
                        (gList[groupIDs[x, y - 1]].libC = 1))) then
                 protPoints[x, y] := 1
              else if (y < maxPoint) and
                      ((bord[x, y + 1] = 0) or
                       ((bord[x, y + 1] = -1) and
                        (gList[groupIDs[x, y + 1]].libC = 1))) then
                 protPoints[x, y] := 1
            end;
        end;
  for x := 0 to maxPoint do
    for y := 0 to maxPoint do
      if bord[x, y] <> 0 then
        begin
          connectMap[x, y] := 0;
          protPoints[x, y] := 0;
        end;
end { genConnects };

{
  generates the whole state of the game.
}
procedure genState;
var
  i, j: integer;
begin { genState }
  inGenState := true;
  respreicen;
  markDead;
  markLive;
  spread;
  genConnects;
  inGenState := false;
end { genState };

{
  generates a value for the [x, y] location that appears to get larger
  for points that are saddle points in the influence graph (klein)
}
function tencen(x, y: integer): integer;
var
  a, b, c, d, w, z: integer;
begin { tencen }
  if kleim[x, y] > -1 then  { if he does not influence this area, return 50 }
    begin
      tencen := 50;
      exit(tencen);
    end;
  w := kleim[x, y]; { w <= -1 }
  a := iNil;
  if x > 0 then
    if kleim[x - 1, y] > -1 then  { if neighbor is not influenced by him }
      a := kleim[x - 1, y] - w;   { score is sum of his influence on central }
  b := iNil;                      {  point and my influence on this neighbor }
  if y > 0 then
    if kleim[x, y - 1] > -1 then
      b := kleim[x, y - 1] - w;
  c := iNil;
  if x < maxPoint then
    if kleim[x + 1, y] > -1 then
      c := kleim[x + 1, y] - w;
  d := iNil;
  if y < maxPoint then
    if kleim[x, y + 1] > -1 then
      d := kleim[x, y + 1] - w;
  z := a;             { z := max(a, b, c, d) }
  if z <> iNil then
    begin
      if (b <> iNil) and
         (b > z) then
        z := b;
    end
  else
    z := b;
  if z <> iNil then
    begin
      if (c <> iNil) and
         (c > z) then
        z := c;
    end
  else
    z := c;
  if z <> iNil then
    begin
      if (d <> iNil) and
         (d > z) then
        z := d;
    end
  else
    z := d;
  if (z <> iNil) and
     ((x = 0) or
      (y = 0) or
      (x = maxPoint) or
      (y = maxPoint)) then
    z := z * 2;     { double z if on the edge of the board ?? }
  if z <> iNil then
    tencen := z
  else
    tencen := 50;
end { tencen };

procedure initGPUtils;
begin { initGPUtils }
  initArray(markBoard);
  initState;
  marker := 0;
  playMark := 0;
  with gList[0] do
    begin
      isLive := false;
      isDead := false;
      libC := 0;
      size := 0;
      numEyes := 0;
      lx := -1;
      ly := -1;
    end;
  gMap[0] := 0;
  dbStop := false;
  inGenState := false;
end. { initGPUtils }

SHAR_EOF
fi
if test -f 'goPlayer.pas'
then
    echo shar: "will not over-write existing file 'goPlayer.pas'"
else
cat << \SHAR_EOF > 'goPlayer.pas'
{---------------------------------------------------------------}
{ GoPlayer.Pas                                                  }
{                                                               }
{ Go Move Generator                                             }
{ Copyright (c) 1983 by Three Rivers Computer Corp.             }
{                                                               }
{ Written: January 17, 1983 by Stoney Ballard                   }
{ Edit History:                                                 }
{---------------------------------------------------------------}

module goPlayer;

exports

imports goCom from goCom;

{ returns true if a move was generated, false for a pass }
function playMove(who: sType; var xLoc, yLoc: integer): boolean;
procedure showPlayState(who: sType);
procedure initGoPlayer;

var
  playReason: string;
  playLevel: integer;
  maxPlayLevel: integer;

private

imports goPlayUtils from goPlayUtils;
imports popUp from popUp;
imports goBoard from goBoard;
imports perq_string from perq_string;
imports io_others from io_others;

var
  saveNLibs: boolean;
  stateMenu: pNameDesc;

exception broken;

procedure blek(var moveX, moveY: integer);
label
  1; { done }

var
  x, y: integer;
  dapList1, dapList2, dapList3: pointList;

  {
    Checks out a move.
    If my stone is not killable then true.
  }
  function safeMove(x, y: integer): boolean;
  var
    gbx, gby: integer;
  begin { safeMove }
    plei(x, y, 1);              { try playing at point }
    if killFlag then { I shouldn't kill if lookForKill didn't }
      safeMove := false
    else if gList[groupIDs[x, y]].libC < 2 then
      begin                   { if it is in atari or dead }
        safeMove := false;      { reject it }
      end
    else if gList[groupIDs[x, y]].libC <= treeLibLim then { see if killable }
      if playLevel > 0 then
        safeMove := not killable(x, y, gbx, gby)
      else
        safeMove := true
    else
      safeMove := true;
    restoreState;
  end { safeMove };

  function heCanCut(x, y: integer): boolean;
  var
    gx, gy: integer;
  begin { heCanCut }
    if playLevel > 3 then
      begin
        plei(x, y, -1);  { try his cut }
        heCanCut := not killable(x, y, gx, gy);
        restoreState;
      end
    else
      heCanCut := true;
  end { heCanCut };

  {
    Plays on a corner point if possible
    returns true if so
  }
  function takeCorner(var x, y: integer): boolean;
  var
    field, i: integer;

    {
      checks a point for no influence and no neighbors
      sets up return vars and exits takeCorner if ok
    }
    procedure checkPos(tx, ty, field: integer);
    var
      ok: boolean;
    begin { checkPos }
      ok := (((field = 0) and (kleim[tx, ty] = 0)) or  { if in field limits }
             ((field > 0) and
              (kleim[tx, ty] >= 0) and (kleim[tx, ty] <= field)) or
             ((field < 0) and
              (kleim[tx, ty] <= 0) and (kleim[tx, ty] >= field))) and
            (bord[tx - 1, ty] = 0) and { and no neighbors }
            (bord[tx + 1, ty] = 0) and
            (bord[tx, ty - 1] = 0) and
            (bord[tx, ty + 1] = 0);
      if ok then
        begin
          x := tx;
          y := ty;
          takeCorner := true;
          exit(takeCorner);
        end;
    end { checkPos };

  begin { takeCorner }
    playReason := 'takeCorner';
    i := maxPoint - 3;
    field := -1;
    repeat
      if field = -1 then
        field := 0
      else if field = 0 then
        field := 4
      else
        field := -4;
      checkPos(2, 3, field);
      checkPos(3, 2, field);
      checkPos(2, i, field);
      checkPos(3, i + 1, field);
      checkPos(i, i + 1, field);
      checkPos(i + 1, i, field);
      checkPos(i, 2, field);
      checkPos(i + 1, 3, field);
      checkPos(2, 4, field);
      checkPos(4, 2, field);
      checkPos(2, i - 1, field);
      checkPos(4, i + 1, field);
      checkPos(i - 1, i + 1, field);
      checkPos(i + 1, i - 1, field);
      checkPos(i + 1, 4, field);
      checkPos(i - 1, 2, field);
    until field = -4;
    takeCorner := false;
  end { takeCorner };

  {
    first phase of 3-line extentions
  }
  function extend(var x, y: integer): boolean;
  var
    i: integer;
  begin { extend }
    playReason := 'extend';
    for i := 2 to maxPoint - 2 do   { look along a three line }
      if (kleim[2, i] = 0) and
         (bord[1, i] = 0) and
         (bord[3, i] = 0) and
         (bord[2, i - 1] = 0) and
         (bord[2, i + 1] = 0) then
        begin
          x := 2;        { return the first point that there's nothing around }
          y := i;
          extend := true;
          exit(extend);
        end;
    for i := 2 to maxPoint - 2 do         { another 3-line extention }
      if (kleim[i, maxPoint - 2] = 0) and
         (bord[i - 1, maxPoint - 2] = 0) and
         (bord[i + 1, maxPoint - 2] = 0) and
         (bord[i, maxPoint - 1] = 0) and
         (bord[i, maxPoint - 3] = 0) then
        begin
          x := i;
          y := maxPoint - 2;
          extend := true;
          exit(extend);
        end;
    for i := maxPoint - 2 downto 2 do     { another 3-line extention }
      if (kleim[maxPoint - 2, i] = 0) and
         (bord[maxPoint - 1, i] = 0) and
         (bord[maxPoint - 3, i] = 0) and
         (bord[maxPoint - 2, i - 1] = 0) and
         (bord[maxPoint - 2, i + 1] = 0) then
        begin
          x := maxPoint - 2;
          y := i;
          extend := true;
          exit(extend);
        end;
    for i := maxPoint - 2 downto 2 do    { another 3-line extention }
      if (kleim[i, 2] = 0) and
         (bord[i - 1, 2] = 0) and
         (bord[i + 1, 2] = 0) and
         (bord[i, 1] = 0) and
         (bord[i, 3] = 0) then
        begin
          x := i;
          y := 2;
          extend := true;
          exit(extend);
        end;
    extend := false;
  end { extend };

  {
    second phase of extentions - plays in my lowest influence spots on
    the 3-lines, so long as they are not touching anything
  }
  function extend2(var x, y: integer): boolean;
  var
    i, rekrd, veliu: integer;
  begin { extend2 }
    playReason := 'extend2';
    rekrd := iNil;
    x := iNil;
    y := iNil;
    for i := 3 to maxPoint - 3 do    { scan a 3-line }
      if legal[2, i] then         { if there is nobody there }
        begin
          veliu := kleim[2, i];     { get influence }
          if (veliu < 7) and        { a reasonable hole in my wall }
             (veliu > -5) and       { or a reasonable gap in his }
             (bord[2, i + 1] = 0) and { not in contact with any stones }
             (bord[2, i - 1] = 0) then
            if (rekrd <> iNil) and
               (veliu < rekrd) then
              begin
                rekrd := veliu;     { rekrd gets the smallest value }
                x := 2;              { that was seen along all the 3-lines }
                y := i;              { x and y save that location }
              end
            else if rekrd = iNil then
              begin
                rekrd := veliu;
                x := 2;
                y := i;
              end;
        end;
    for i := 3 to maxPoint - 3 do
      if legal[i, 2] then
        begin
          veliu := kleim[i, 2];
          if (veliu < 7) and
             (veliu > -5) and
             (bord[i + 1, 2] = 0) and
             (bord[i - 1, 2] = 0) then
            if (rekrd <> iNil) and
               (veliu < rekrd) then
              begin
                rekrd := veliu;
                x := i;
                y := 2;
              end
            else if rekrd = iNil then
              begin
                rekrd := veliu;
                x := i;
                y := 2;
              end;
        end;
    for i := maxPoint - 3 downto 3 do
      if legal[maxPoint - 2, i] then
        begin
          veliu := kleim[maxPoint - 2, i];
          if (veliu < 7) and
             (veliu > -5) and
             (bord[maxPoint - 2, i + 1] = 0) and
             (bord[maxPoint - 2, i - 1] = 0) then
            if (rekrd <> iNil) and
               (veliu < rekrd) then
              begin
                rekrd := veliu;
                x := maxPoint - 2;
                y := i;
              end
            else if rekrd = iNil then
              begin
                rekrd := veliu;
                x := maxPoint - 2;
                y := i;
              end;
        end;
    for i := maxPoint - 3 downto 3 do
      if legal[i, maxPoint - 2] then
        begin
          veliu := kleim[i, maxPoint - 2];
          if (veliu < 7) and
             (veliu > -5) and
             (bord[i + 1, maxPoint - 2] = 0) and
             (bord[i - 1, maxPoint - 2] = 0) then
            if (rekrd <> iNil) and
               (veliu < rekrd) then
              begin
                rekrd := veliu;
                x := i;
                y := maxPoint - 2;
              end
            else if rekrd = iNil then
              begin
                rekrd := veliu;
                x := i;
                y := maxPoint - 2;
              end;
        end;
    extend2 := x <> iNil;
  end { extend2 };

  {
    connects against enemy cuts
  }
  function connectCut(var x, y: integer): boolean;
  var
    i, j, nap, gid, infl: integer;

  begin { connectCut }
    playreason := 'connectCut';
    connectCut := true;
    for i := 0 to maxPoint do
      for j := 0 to maxPoint do
        if legal[i, j] and
           (protPoints[i, j] = 0) then   { not a protected point }
          begin
            nap := 0;     { how many of my stones am I adjacent to? }
            if (i > 0) and (bord[i - 1, j] = 1) then
              begin
                nap := nap + 1;
                pList.p[nap].px := i - 1;
                pList.p[nap].py := j;
              end;
            if (j > 0) and (bord[i, j - 1] = 1) then
              begin
                nap := nap + 1;
                pList.p[nap].px := i;
                pList.p[nap].py := j - 1;
              end;
            if (i < maxPoint) and (bord[i + 1, j] = 1) then
              begin
                nap := nap + 1;
                pList.p[nap].px := i + 1;
                pList.p[nap].py := j;
              end;
            if (j < maxPoint) and (bord[i, j + 1] = 1) then
              begin
                nap := nap + 1;
                pList.p[nap].px := i;
                pList.p[nap].py := j + 1;
              end;
            if nap = 1 then { possible knight's or 2-point extention }
              with pList.p[1] do
                begin
                  gid := groupIDs[px, py];
                  if (i > 0) and (i < maxPoint) and
                     (ndbord[i - 1, j] = 1) and
                     (ndbord[i + 1, j] = 0) then { contact on left }
                    begin
                      if ((j > 0) and (ndbord[i, j - 1] = -1) and
                          (ndbord[i + 1, j - 1] = 1) and
                          (gid <> groupIDs[i + 1, j - 1])) or
                         ((j < maxPoint) and (ndbord[i, j + 1] = -1) and
                          (ndbord[i + 1, j + 1] = 1) and
                          (gid <> groupIDs[i + 1, j + 1])) or
                         ((((j > 0) and (ndbord[i, j - 1] = -1)) or
                           ((j < maxPoint) and (ndbord[i, j + 1] = -1))) and
                          (i < (maxPoint - 1)) and
                          (ndbord[i + 2, j] = 1) and
                          (gid <> groupIDs[i + 2, j])) then
                        begin
                          x := i;
                          y := j;
                          if safeMove(x, y) then
                            exit(connectCut);
                        end;
                    end
                  else if (i < maxPoint) and (i > 0) and
                          (ndbord[i + 1, j] = 1) and
                          (ndbord[i - 1, j] = 0) then { r }
                    begin
                      if ((j > 0) and (ndbord[i, j - 1] = -1) and
                          (ndbord[i - 1, j - 1] = 1) and
                          (gid <> groupIDs[i - 1, j - 1])) or
                         ((j < maxPoint) and (ndbord[i, j + 1] = -1) and
                          (ndbord[i - 1, j + 1] = 1) and
                          (gid <> groupIDs[i - 1, j + 1])) or
                         ((((j > 0) and (ndbord[i, j - 1] = -1)) or
                           ((j < maxPoint) and (ndbord[i, j + 1] = -1))) and
                          (i > 1) and
                          (ndbord[i - 2, j] = 1) and
                          (gid <> groupIDs[i - 2, j])) then
                        begin
                          x := i;
                          y := j;
                          if safeMove(x, y) then
                            exit(connectCut);
                        end;
                    end
                  else if (j > 0) and (j < maxPoint) and
                          (ndbord[i, j - 1] = 1) and
                          (ndbord[i, j + 1] = 0) then { top }
                    begin
                      if ((i > 0) and (ndbord[i - 1, j] = -1) and
                          (ndbord[i - 1, j + 1] = 1) and
                          (gid <> groupIDs[i - 1, j + 1])) or
                         ((i < maxPoint) and (ndbord[i + 1, j] = -1) and
                          (ndbord[i + 1, j + 1] = 1) and
                          (gid <> groupIDs[i + 1, j + 1])) or
                         ((((i > 0) and (ndbord[i - 1, j] = -1)) or
                           ((i < maxPoint) and (ndbord[i + 1, j] = -1))) and
                          (j < (maxPoint - 1)) and
                          (ndbord[i, j + 2] = 1) and
                          (gid <> groupIDs[i, j + 2])) then
                        begin
                          x := i;
                          y := j;
                          if safeMove(x, y) then
                            exit(connectCut);
                        end;
                    end
                  else if (j > 0) and (j < maxPoint) and
                          (ndbord[i, j + 1] = 1) and
                          (ndbord[i, j - 1] = 0) then { bottom }
                    begin
                      if ((i > 0) and (ndbord[i - 1, j] = -1) and
                          (ndbord[i - 1, j - 1] = 1) and
                          (gid <> groupIDs[i - 1, j - 1])) or
                         ((i < maxPoint) and (ndbord[i + 1, j] = -1) and
                          (ndbord[i + 1, j - 1] = 1) and
                          (gid <> groupIDs[i + 1, j - 1])) or
                         ((((i > 0) and (ndbord[i - 1, j] = -1)) or
                           ((i < maxPoint) and (ndbord[i + 1, j] = -1))) and
                          (j > 1) and
                          (ndbord[i, j - 2] = 1) and
                          (gid <> groupIDs[i, j - 2])) then
                        begin
                          x := i;
                          y := j;
                          if safeMove(x, y) then
                            exit(connectCut);
                        end;
                    end;
                end
            else if nap = 2 then { diagonal or 1-point extention }
              begin
                if groupIDs[pList.p[1].px, pList.p[1].py] <>
                   groupIDs[pList.p[2].px, pList.p[2].py] then
                  begin
                    if (pList.p[1].px <> pList.p[2].px) and
                       (pList.p[1].py <> pList.p[2].py) then { diag }
                      begin
                        spanGroup(pList.p[1].px,
                                  pList.p[1].py, pList1);
                        spanGroup(pList.p[2].px,
                                  pList.p[2].py, pList2);
                        intersectPlist(pList1, pList2, pList3);
                        if pList3.indx = 1 then
                          if (i > 0) and (ndbord[i - 1, j] = -1) or
                             (i < maxPoint) and (ndbord[i + 1, j] = -1) or
                             (j > 0) and (ndbord[i, j - 1] = -1) or
                             (j < maxPoint) and (ndbord[i, j + 1] = -1) then
                            begin { must make direct connection }
                              x := i;
                              y := j;
                              if heCanCut(x, y) then
                                if safeMove(x, y) then
                                  exit(connectCut);
                            end
                          else if heCanCut(i, j) then
                            begin     { protect point if possible }
                              infl := 1000;
                              if (i > 0) and legal[i - 1, j] and
                                 ((i = 1) or (ndbord[i - 2, j] = 0)) and
                                 ((j = 0) or (ndbord[i - 1, j - 1] = 0)) and
                                 ((j = maxPoint) or
                                  (ndbord[i - 1, j + 1] = 0)) then
                                if safeMove(i - 1, j) then
                                  if kleim[i - 1, j] < infl then
                                    begin
                                      x := i - 1;
                                      y := j;
                                      infl := kleim[i - 1, j];
                                    end;
                              if (j > 0) and legal[i, j - 1] and
                                 ((j = 1) or (ndbord[i, j - 2] = 0)) and
                                 ((i = 0) or (ndbord[i - 1, j - 1] = 0)) and
                                 ((i = maxPoint) or
                                  (ndbord[i + 1, j - 1] = 0)) then
                                if safeMove(i, j - 1) then
                                  if kleim[i, j - 1] < infl then
                                    begin
                                      x := i;
                                      y := j - 1;
                                      infl := kleim[i, j - 1];
                                    end;
                              if (i < maxPoint) and legal[i + 1, j] and
                                 ((i = (maxPoint - 1)) or
                                  (ndbord[i + 2, j] = 0)) and
                                 ((j = 0) or (ndbord[i + 1, j - 1] = 0)) and
                                 ((j = maxPoint) or
                                  (ndbord[i + 1, j + 1] = 0)) then
                                if safeMove(i + 1, j) then
                                  if kleim[i + 1, j] < infl then
                                    begin
                                      x := i + 1;
                                      y := j;
                                      infl := kleim[i + 1, j];
                                    end;
                              if (j < maxPoint) and legal[i, j + 1] and
                                 ((j = (maxPoint - 1)) or
                                  (ndbord[i, j + 2] = 0)) and
                                 ((i = 0) or (ndbord[i - 1, j + 1] = 0)) and
                                 ((i = maxPoint) or
                                  (ndbord[i + 1, j + 1] = 0)) then
                                if safeMove(i, j + 1) then
                                  if kleim[i, j + 1] < infl then
                                    begin
                                      x := i;
                                      y := j + 1;
                                      infl := kleim[i, j + 1];
                                    end;
                              if infl < 1000 then
                                exit(connectCut);
                              x := i;      { direct connection }
                              y := j;
                              if safeMove(x, y) then
                                exit(connectCut);
                            end;
                      end
                    else { 1-point extension, only protect if threatened }
                      begin
                        if (i > 0) and (ndbord[i - 1, j] = -1) or
                           (j > 0) and (ndbord[i, j - 1] = -1) or
                           (i < maxPoint) and (ndbord[i + 1, j] = -1) or
                           (j < maxPoint) and (ndbord[i, j + 1] = -1) then
                          begin
                            x := i;
                            y := j;
                            if heCanCut(x, y) then
                              if safeMove(x, y) then
                                exit(connectCut);
                          end;
                      end;
                  end;
              end
            else if nap = 3 then { unprotected, but me on 3 sides }
              begin
                if (groupIDs[pList.p[1].px, pList.p[1].py] <>
                    groupIDs[pList.p[2].px, pList.p[2].py]) or
                   (groupIDs[pList.p[1].px, pList.p[1].py] <>
                    groupIDs[pList.p[3].px, pList.p[3].py]) or
                   (groupIDs[pList.p[3].px, pList.p[3].py] <>
                    groupIDs[pList.p[2].px, pList.p[2].py]) then
                  begin
                    spanGroup(pList.p[1].px, pList.p[1].py, pList1);
                    spanGroup(pList.p[2].px, pList.p[2].py, pList2);
                    intersectPlist(pList1, pList2, pList3);
                    spanGroup(pList.p[3].px, pList.p[3].py, pList2);
                    intersectPlist(pList2, pList3, pList1);
                    if pList1.indx = 1 then { a common connect point }
                      if heCanCut(i, j) then
                        if safeMove(i, j) then
                          begin
                            x := i;
                            y := j;
                            exit(connectCut);
                          end;
                  end;
              end;
          end;
    connectCut := false;
  end { connectCut };

  {
    cuts the enemy
  }
  function cutHim(var x, y: integer): boolean;
  var
    i, j, nap, gid: integer;
  begin { cutHim }
    playreason := 'cutHim';
    cutHim := true;
    for i := 0 to maxPoint do
      for j := 0 to maxPoint do
        if legal[i, j] then
          begin
            nap := 0;     { how many of his stones am I adjacent to? }
            if (i > 0) and (ndbord[i - 1, j] = -1) then
              begin
                nap := nap + 1;
                pList.p[nap].px := i - 1;
                pList.p[nap].py := j;
              end;
            if (j > 0) and (ndbord[i, j - 1] = -1) then
              begin
                nap := nap + 1;
                pList.p[nap].px := i;
                pList.p[nap].py := j - 1;
              end;
            if (i < maxPoint) and (ndbord[i + 1, j] = -1) then
              begin
                nap := nap + 1;
                pList.p[nap].px := i + 1;
                pList.p[nap].py := j;
              end;
            if (j < maxPoint) and (ndbord[i, j + 1] = -1) then
              begin
                nap := nap + 1;
                pList.p[nap].px := i;
                pList.p[nap].py := j + 1;
              end;
            if nap = 1 then { possible knight's or 2-point extention }
              with pList.p[1] do
                begin
                  gid := groupIDs[px, py];
                  if (i > 0) and (i < maxPoint) and
                     (ndbord[i - 1, j] = -1) and
                     (connectMap[i, j] > 0) then { contact on left }
                    begin
                      if ((j > 0) and
                          (ndbord[i + 1, j - 1] = -1) and
                          (gid <> groupIDs[i + 1, j - 1])) or
                         ((j < maxPoint) and
                          (ndbord[i + 1, j + 1] = -1) and
                          (gid <> groupIDs[i + 1, j + 1])) or
                         ((i < (maxPoint - 1)) and
                          (ndbord[i + 1, j] = 0) and
                          (ndbord[i + 2, j] = -1) and
                          (gid <> groupIDs[i + 2, j])) then
                        begin
                          x := i;
                          y := j;
                          if safeMove(x, y) then
                            exit(cutHim);
                        end;
                    end
                  else if (i < maxPoint) and (i > 0) and
                          (ndbord[i + 1, j] = -1) and
                          (connectMap[i, j] > 0) then { r }
                    begin
                      if ((j > 0) and
                          (ndbord[i - 1, j - 1] = -1) and
                          (gid <> groupIDs[i - 1, j - 1])) or
                         ((j < maxPoint) and
                          (ndbord[i - 1, j + 1] = -1) and
                          (gid <> groupIDs[i - 1, j + 1])) or
                         ((i > 1) and
                          (ndbord[i - 1, j] = 0) and
                          (ndbord[i - 2, j] = -1) and
                          (gid <> groupIDs[i - 2, j])) then
                        begin
                          x := i;
                          y := j;
                          if safeMove(x, y) then
                            exit(cutHim);
                        end;
                    end
                  else if (j > 0) and (j < maxPoint) and
                          (ndbord[i, j - 1] = -1) and
                          (connectMap[i, j] > 0) then { top }
                    begin
                      if ((i > 0) and
                          (ndbord[i - 1, j + 1] = -1) and
                          (gid <> groupIDs[i - 1, j + 1])) or
                         ((i < maxPoint) and
                          (ndbord[i + 1, j + 1] = -1) and
                          (gid <> groupIDs[i + 1, j + 1])) or
                         ((j < (maxPoint - 1)) and
                          (ndbord[i, j + 1] = 0) and
                          (ndbord[i, j + 2] = -1) and
                          (gid <> groupIDs[i, j + 2])) then
                        begin
                          x := i;
                          y := j;
                          if safeMove(x, y) then
                            exit(cutHim);
                        end;
                    end
                  else if (j > 0) and (j < maxPoint) and
                          (ndbord[i, j + 1] = -1) and
                          (connectMap[i, j] > 0) then { bottom }
                    begin
                      if ((i > 0) and
                          (ndbord[i - 1, j - 1] = -1) and
                          (gid <> groupIDs[i - 1, j - 1])) or
                         ((i < maxPoint) and
                          (ndbord[i + 1, j - 1] = -1) and
                          (gid <> groupIDs[i + 1, j - 1])) or
                         ((j > 1) and
                          (ndbord[i, j - 1] = 0) and
                          (ndbord[i, j - 2] = -1) and
                          (gid <> groupIDs[i, j - 2])) then
                        begin
                          x := i;
                          y := j;
                          if safeMove(x, y) then
                            exit(cutHim);
                        end;
                    end;
                end
            else if nap = 2 then { diagonal or 1-point extention }
              begin
                if groupIDs[pList.p[1].px, pList.p[1].py] <>
                   groupIDs[pList.p[2].px, pList.p[2].py] then
                  begin
                    if (pList.p[1].px <> pList.p[2].px) and
                       (pList.p[1].py <> pList.p[2].py) then { diag }
                      begin
                        spanGroup(pList.p[1].px,
                                  pList.p[1].py, pList1);
                        spanGroup(pList.p[2].px,
                                  pList.p[2].py, pList2);
                        intersectPlist(pList1, pList2, pList3);
                        if pList3.indx = 1 then
                          begin
                            x := i;
                            y := j;
                            if safeMove(x, y) then
                              exit(cutHim);
                          end;
                      end
                    else { 1-point extension, only cut if connected }
                      begin
                        if connectMap[i, j] > 0 then
                          begin
                            x := i;
                            y := j;
                            if safeMove(x, y) then
                              exit(cutHim);
                          end;
                      end;
                  end;
              end
            else if nap = 3 then { unprotected, but him on 3 sides }
              begin
                if (groupIDs[pList.p[1].px, pList.p[1].py] <>
                    groupIDs[pList.p[2].px, pList.p[2].py]) or
                   (groupIDs[pList.p[1].px, pList.p[1].py] <>
                    groupIDs[pList.p[3].px, pList.p[3].py]) or
                   (groupIDs[pList.p[3].px, pList.p[3].py] <>
                    groupIDs[pList.p[2].px, pList.p[2].py]) then
                  begin
                    spanGroup(pList.p[1].px, pList.p[1].py, pList1);
                    spanGroup(pList.p[2].px, pList.p[2].py, pList2);
                    intersectPlist(pList1, pList2, pList3);
                    spanGroup(pList.p[3].px, pList.p[3].py, pList2);
                    intersectPlist(pList2, pList3, pList1);
                    if pList1.indx = 1 then { a common connect point }
                      if safeMove(i, j) then
                        begin
                          x := i;
                          y := j;
                          exit(cutHim);
                        end;
                  end;
              end;
          end;
    cutHim := false;
  end { cutHim };

  {
    blocks enemy cuts thru 1-point extensions
  }
  function blockCut(var x, y: integer): boolean;
  var
    i, j: integer;
  begin { blockCut }
    playReason := 'blockCut';
    blockCut := true;
    for i := 0 to maxPoint do
      for j := 0 to maxPoint do
        if legal[i, j] then
          begin
            if (i > 0) and (j > 0) and (j < maxPoint) then
              begin
                if (ndbord[i - 1, j] = -1) and
                   (ndbord[i - 1, j - 1] = 1) and
                   (ndbord[i - 1, j + 1] = 1) and
                   (groupIDs[i - 1, j - 1] <> groupIDs[i - 1, j + 1]) then
                  begin
                    x := i;
                    y := j;
                    if heCanCut(x, y) then
                      if safeMove(x, y) then
                        exit(blockCut);
                  end;
              end;
            if (i < maxPoint) and (j > 0) and (j < maxPoint) then
              begin
                if (ndbord[i + 1, j] = -1) and
                   (ndbord[i + 1, j - 1] = 1) and
                   (ndbord[i + 1, j + 1] = 1) and
                   (groupIDs[i + 1, j - 1] <> groupIDs[i + 1, j + 1]) then
                  begin
                    x := i;
                    y := j;
                    if heCanCut(x, y) then
                      if safeMove(x, y) then
                        exit(blockCut);
                  end;
              end;
            if (j > 0) and (i > 0) and (i < maxPoint) then
              begin
                if (ndbord[i, j - 1] = -1) and
                   (ndbord[i - 1, j - 1] = 1) and
                   (ndbord[i + 1, j - 1] = 1) and
                   (groupIDs[i - 1, j - 1] <> groupIDs[i + 1, j - 1]) then
                  begin
                    x := i;
                    y := j;
                    if heCanCut(x, y) then
                      if safeMove(x, y) then
                        exit(blockCut);
                  end;
              end;
            if (j < maxPoint) and (i > 0) and (i < maxPoint) then
              begin
                if (ndbord[i, j + 1] = -1) and
                   (ndbord[i - 1, j + 1] = 1) and
                   (ndbord[i + 1, j + 1] = 1) and
                   (groupIDs[i - 1, j + 1] <> groupIDs[i + 1, j + 1]) then
                  begin
                    x := i;
                    y := j;
                    if heCanCut(x, y) then
                      if safeMove(x, y) then
                        exit(blockCut);
                  end;
              end;
          end;
    blockCut := false;
  end { blockCut };

  {
    drops to the edge of the board if threatened
  }
  function dropToEdge(var x, y: integer): boolean;
  var
    i: integer;
  begin { dropToEdge }
    dropToEdge := true;
    playReason := 'dropToEdge';
    for i := 1 to maxPoint - 1 do
      begin
        if legal[1, i] then
          if (ndbord[2, i] = 1) and
             (ndbord[0, i] = 0) and
             (ndbord[1, i - 1] < 1) and
             (ndbord[1, i + 1] < 1) and
             ((ndbord[2, i - 1] = -1) or
              (ndbord[2, i + 1] = -1) or
              (ndbord[1, i - 1] = -1) or
              (ndbord[1, i + 1] = -1)) then
            begin
              x := 1;
              y := i;
              if safeMove(x, y) then
                exit(dropToEdge);
            end;
        if legal[maxPoint - 1, i] then
          if (ndbord[maxPoint - 2, i] = 1) and
             (ndbord[maxPoint, i] = 0) and
             (ndbord[maxPoint - 1, i - 1] < 1) and
             (ndbord[maxPoint - 1, i + 1] < 1) and
             ((ndbord[maxPoint - 2, i - 1] = -1) or
              (ndbord[maxPoint - 2, i + 1] = -1) or
              (ndbord[maxPoint - 1, i - 1] = -1) or
              (ndbord[maxPoint - 1, i + 1] = -1)) then
            begin
              x := maxPoint - 1;
              y := i;
              if safeMove(x, y) then
                exit(dropToEdge);
            end;
        if legal[i, 1] then
          if (ndbord[i, 2] = 1) and
             (ndbord[i, 0] = 0) and
             (ndbord[i - 1, 1] < 1) and
             (ndbord[i + 1, 1] < 1) and
             ((ndbord[i - 1, 2] = -1) or
              (ndbord[i + 1, 2] = -1) or
              (ndbord[i - 1, 1] = -1) or
              (ndbord[i + 1, 1] = -1)) then
            begin
              x := i;
              y := 1;
              if safeMove(x, y) then
                exit(dropToEdge);
            end;
        if legal[i, maxPoint - 1] then
          if (ndbord[i, maxPoint - 2] = 1) and
             (ndbord[i, maxPoint] = 0) and
             (ndbord[i - 1, maxPoint - 1] < 1) and
             (ndbord[i + 1, maxPoint - 1] < 1) and
             ((ndbord[i - 1, maxPoint - 2] = -1) or
              (ndbord[i + 1, maxPoint - 2] = -1) or
              (ndbord[i - 1, maxPoint - 1] = -1) or
              (ndbord[i + 1, maxPoint - 1] = -1)) then
            begin
              x := i;
              y := maxPoint - 1;
              if safeMove(x, y) then
                exit(dropToEdge);
            end;
        if legal[0, i] then
          if (ndbord[1, i] = 1) and
             (ndbord[0, i - 1] < 1) and
             (ndbord[0, i + 1] < 1) and
             (((ndbord[1, i - 1] = -1) and
               (ndbord[1, i + 1] = -1)) or
              (ndbord[0, i - 1] = -1) or
              (ndbord[0, i + 1] = -1)) then
            begin
              x := 0;
              y := i;
              if safeMove(x, y) then
                exit(dropToEdge);
            end;
        if legal[maxPoint, i] then
          if (ndbord[maxPoint - 1, i] = 1) and
             (ndbord[maxPoint, i - 1] < 1) and
             (ndbord[maxPoint, i + 1] < 1) and
             (((ndbord[maxPoint - 1, i - 1] = -1) and
               (ndbord[maxPoint - 1, i + 1] = -1)) or
              (ndbord[maxPoint, i - 1] = -1) or
              (ndbord[maxPoint, i + 1] = -1)) then
            begin
              x := maxPoint;
              y := i;
              if safeMove(x, y) then
                exit(dropToEdge);
            end;
        if legal[i, 0] then
          if (ndbord[i, 1] = 1) and
             (ndbord[i - 1, 0] < 1) and
             (ndbord[i + 1, 0] < 1) and
             (((ndbord[i - 1, 1] = -1) and
               (ndbord[i + 1, 1] = -1)) or
              (ndbord[i - 1, 0] = -1) or
              (ndbord[i + 1, 0] = -1)) then
            begin
              x := i;
              y := 0;
              if safeMove(x, y) then
                exit(dropToEdge);
            end;
        if legal[i, maxPoint] then
          if (ndbord[i, maxPoint - 1] = 1) and
             (ndbord[i - 1, maxPoint] < 1) and
             (ndbord[i + 1, maxPoint] < 1) and
             (((ndbord[i - 1, maxPoint - 1] = -1) and
               (ndbord[i + 1, maxPoint - 1] = -1)) or
              (ndbord[i - 1, maxPoint] = -1) or
              (ndbord[i + 1, maxPoint] = -1)) then
            begin
              x := i;
              y := maxPoint;
              if safeMove(x, y) then
                exit(dropToEdge);
            end;
      end;
    dropToEdge := false;
  end { dropToEdge };

  {
    Plays a move that requires a response on the opponent's part
  }
  function threaten(var x, y: integer): boolean;
  var
    i, j, gx, gy, tNum: integer;
  begin { threaten }
    playReason := 'threaten';
    initArray(threatBord);
    for i := 1 to maxGroupID do
      with gList[i] do
        if (not isLive) and
           (ndBord[lx, ly] = -1) then
          begin
            spanGroup(lx, ly, pList);
            for j := 1 to pList.indx do
              with pList.p[j] do
                if legal[px, py] then
                  begin
                    plei(px, py, 1);
                    if gList[groupIDs[px, py]].libC > 1 then
                      if killable(lx, ly, gx, gy) then
                        threatBord[px, py] := threatBord[px, py] + 1;
                    restoreState;
                  end;
          end;
    tNum := 0;
    for i := 0 to maxPoint do
      for j := 0 to maxPoint do
        if (threatBord[i, j] > tNum) and
           ((threatBord[i, j] > 1) or
            (connectMap[i, j] > 0)) then
          begin
            tNum := threatBord[i, j];
            x := i;
            y := j;
          end;
    threaten := tNum > 0;
  end { threaten };

  {
    Extends walls in a connected fashion.
    Finds the lowest influence (mine) point that is connected to one
    of my groups.
    Only looks in the center of the board.
  }
  function extendWall(var x, y: integer): boolean;
  var
    infl, i, j: integer;
  begin { extendWall }
    playReason := 'extendWall';
    x := iNil;
    y := iNil;
    infl := 11;
    for i := 2 to maxPoint - 2 do
      for j := 2 to maxPoint - 2 do
        if legal[i, j] then
          if connectMap[i, j] > 0 then
            if (kleim[i, j] < infl) and
               (ndbord[i - 1, j] < 1) and
               (ndbord[i + 1, j] < 1) and
               (ndbord[i, j - 1] < 1) and
               (ndbord[i, j + 1] < 1) and
               ((kleim[i - 1, j] < 0) or
                (kleim[i + 1, j] < 0) or
                (kleim[i, j - 1] < 0) or
                (kleim[i, j + 1] < 0)) then
              if safeMove(i, j) then
                begin
                  infl := kleim[i, j];
                  x := i;
                  y := j;
                end;
    extendWall := x <> iNil;
  end { extendWall };

  {
    Pushes walls in a tightly connected fashion.
    Finds the lowest influence (mine) point that is connected to one
    of my groups.
  }
  function pushWall(var x, y: integer): boolean;
  var
    infl, i, j, na: integer;
  begin { pushWall }
    playReason := 'pushWall';
    x := iNil;
    y := iNil;
    infl := 11;
    for i := 0 to maxPoint do
      for j := 0 to maxPoint do
        if legal[i, j] then
          if connectMap[i, j] > 0 then
            if (kleim[i, j] < infl) and
               (((i > 0) and (ndbord[i - 1, j] = 1)) or
                ((i < maxPoint) and (ndbord[i + 1, j] = 1)) or
                ((j > 0) and (ndbord[i, j - 1] = 1)) or
                ((j < maxPoint) and (ndbord[i, j + 1] = 1)) or
                ((i > 0) and (j > 0) and (ndbord[i - 1, j - 1] = 1)) or
                ((i < maxPoint) and (j > 0) and (ndbord[i + 1, j - 1] = 1)) or
                ((i > 0) and (j < maxPoint) and (ndbord[i - 1, j + 1] = 1)) or
                ((i < maxPoint) and (j < maxPoint) and
                 (ndbord[i + 1, j + 1] = 1))) and
               (((i > 0) and (kleim[i - 1, j] < 0)) or
                ((i < maxPoint) and (kleim[i + 1, j] < 0)) or
                ((j > 0) and (kleim[i, j - 1] < 0)) or
                ((j < maxPoint) and (kleim[i, j + 1] < 0))) then
              begin
                na := 0;
                if (i > 0) and (ndbord[i - 1, j] <> 0) then
                  na := na + 1;
                if (i < maxPoint) and (ndbord[i + 1, j] <> 0) then
                  na := na + 1;
                if (j > 0) and (ndbord[i, j - 1] <> 0) then
                  na := na + 1;
                if (j < maxPoint) and (ndbord[i, j + 1] <> 0) then
                  na := na + 1;
                if na < 3 then
                  if safeMove(i, j) then
                    begin
                      infl := kleim[i, j];
                      x := i;
                      y := j;
                    end;
              end;
    pushWall := x <> iNil;
  end { pushWall };

  {
    check to see if I can kill anything
  }
  function lookForKill(var x, y: integer): boolean;
  var
    i: integer;
  begin { lookForKill }
    playReason := 'lookForKill';
    lookForKill := true;
    for i := 1 to maxGroupID do       { scan the group list }
      with gList[i] do
        if (libC = 1) and
           (ndbord[lx, ly] = -1) then
          begin    { we found a live enemy group with one liberty }
            spanGroup(lx, ly, pList); { find the liberty }
            x := pList.p[1].px;
            y := pList.p[1].py;
            if legal[x, y] then
              exit(lookForKill);
          end;
    lookForKill := false;
  end { lookForKill };

  {
    check to see if I can save anything in atari
  }
  function lookForSave(var x, y: integer): boolean;
  var
    i: integer;
  begin { lookForSave }
    playReason := 'lookForSave';
    lookForSave := true;
    for i := 1 to maxGroupID do       { scan the group list }
      with gList[i] do
        if (libC = 1) and
           (ndbord[lx, ly] = 1) then
            begin
              if saveable(lx, ly, x, y) then { see if I can save it }
                exit(lookForSave);
            end;
    lookForSave := false;
  end { lookForSave };

  {
    check to see if I can save anything with n libs
  }
  function lookForSaveN(var x, y: integer): boolean;
  var
    i: integer;
  begin { lookForSaveN }
    if saveNLibs then
      begin
        playReason := 'lookForSaveN';
        lookForSaveN := true;
        for i := 1 to maxGroupID do       { scan the group list }
          with gList[i] do
            if (libC > 1) and
               (libC <= treeLibLim) and
               (ndbord[lx, ly] = 1) then
                begin
                  if killable(lx, ly, x, y) then
                    if saveable(lx, ly, x, y) then { see if I can save it }
                      exit(lookForSaveN);
                end;
      end;
    lookForSaveN := false;
  end { lookForSaveN };

  {
    check to see if I can attack one of his groups
  }
  function lookForAttack(var x, y: integer): boolean;
  var
    tx, ty, i: integer;
  begin { lookForAttack }
    playReason := 'lookForAttack';
    lookForAttack := true;
    for i := 1 to maxGroupID do       { scan the group list }
      with gList[i] do
        if (not isLive) and
           (libC > 1) and
           (libC <= (treeLibLim + 1)) and
           (ndbord[lx, ly] = -1) then
              begin
                if killable(lx, ly, tx, ty) then { can we kill it? }
                  begin
                    x := tx;        { yep - do so }
                    y := ty;
                    exit(lookForAttack);
                  end;
              end;
    lookForAttack := false;
  end { lookForAttack };

  {
    check to see if I can attack one of his groups
    uses limited depth search so that it can work on larger lib counts
  }
  function findAttack2(var x, y: integer): boolean;
  var
    tx, ty, i, otll: integer;
  begin { findAttack2 }
    if playLevel < 7 then
      begin
        findAttack2 := false;
        exit(findAttack2);
      end;
    playReason := 'findAttack2';
    findAttack2 := true;
    depthLimit := 8;
    otll := treeLibLim;
    for i := 1 to maxGroupID do       { scan the group list }
      with gList[i] do
        if (not isLive) and
           (ndBord[lx, ly] = -1) and
           (libC > 1) then
              begin
                treeLibLim := 6;
                if killable(lx, ly, tx, ty) then { can we kill it? }
                  begin
                    x := tx;        { yep - do so }
                    y := ty;
                    exit(findAttack2);
                  end;
                treeLibLim := otll;
              end;
    findAttack2 := false;
    depthLimit := 100;
  end { findAttack2 };

  function doubleAtari(var x, y: integer): boolean;
  var
    i, j: integer;
  begin { doubleAtari }
    playReason := 'doubleAtari';
    doubleAtari := true;
    for i := 1 to maxGroupID - 1 do
      with gList[i] do
        if (libC = 2) and
           (ndbord[lx, ly] = -1) then { found an atariable group of his }
          begin
            spanGroup(lx, ly, dapList1);
            for j := i + 1 to maxGroupID do
              with gList[j] do
                if (libC = 2) and
                   (ndbord[lx, ly] = -1) then
                begin
                  spanGroup(lx, ly, dapList2);
                  intersectPlist(dapList1, dapList2, dapList3);
                  if dapList3.indx > 0 then
                    with dapList3.p[1] do
                      if legal[px, py] then
                        begin
                          plei(px, py, 1);
                          if gList[groupIDs[px, py]].libC > 1 then
                            begin
                              x := px;
                              y := py;
                              restoreState;
                              exit(doubleAtari);
                            end;
                          restoreState;
                        end;
                end;
          end;
    doubleAtari := false;
  end { doubleAtari };

  {
    ataris a group just for the hell of it
  }
  function atariAnyway(var x, y: integer): boolean;
  var
    i: integer;
  begin { atariAnyway }
    playReason := 'atariAnyway';
    atariAnyway := true;
    for i := 1 to maxGroupID do       { scan the group list }
      with gList[i] do
        if (libC = 2) and
           (ndbord[lx, ly] = -1) then
              begin
                spanGroup(lx, ly, pList);
                with pList.p[1] do
                  if legal[px, py] and
                     ((connectMap[px, py] > 0) or
                      ((px > 0) and (connectMap[px - 1, py] > 0)) or
                      ((px < maxPoint) and (connectMap[px + 1, py] > 0)) or
                      ((py > 0) and (connectMap[px, py - 1] > 0)) or
                      ((py < maxPoint) and (connectMap[px, py + 1] > 0))) then
                    if safeMove(px, py) then
                      begin
                        x := px;
                        y := py;
                        exit(atariAnyway);
                      end;
                with pList.p[2] do
                  if legal[px, py] and
                     ((connectMap[px, py] > 0) or
                      ((px > 0) and (connectMap[px - 1, py] > 0)) or
                      ((px < maxPoint) and (connectMap[px + 1, py] > 0)) or
                      ((py > 0) and (connectMap[px, py - 1] > 0)) or
                      ((py < maxPoint) and (connectMap[px, py + 1] > 0))) then
                    if safeMove(px, py) then
                      begin
                        x := px;
                        y := py;
                        exit(atariAnyway);
                      end;
              end;
    atariAnyway := false;
  end { atariAnyway };

  {
    undercuts his groups
  }
  function underCut(var x, y: integer): boolean;
  var
    i, j: integer;
  begin { underCut }
    playReason := 'underCut';
    underCut := true;
    for i := 1 to maxPoint - 1 do
      begin
        if legal[0, i] then
          begin
            if ndbord[1, i] = -1 then
              if safeMove(0, i) then
                begin
                  x := 0;
                  y := i;
                  exit(underCut);
                end;
          end;
        if legal[maxPoint, i] then
          begin
            if ndbord[maxPoint - 1, i] = -1 then
              if safeMove(maxPoint, i) then
                begin
                  x := maxPoint;
                  y := i;
                  exit(underCut);
                end;
          end;
        if legal[i, 0] then
          begin
            if ndbord[i, 1] = -1 then
              if safeMove(i, 0) then
                begin
                  x := i;
                  y := 0;
                  exit(underCut);
                end;
          end;
        if legal[i, maxPoint] then
          begin
            if ndbord[i, maxPoint - 1] = -1 then
              if safeMove(i, maxPoint) then
                begin
                  x := i;
                  y := maxPoint;
                  exit(underCut);
                end;
          end;
      end;
    underCut := false;
  end { underCut };

  {
    reduces the liberty count of one of his groups
  }
  function reduceHisLiberties(var x, y: integer): boolean;
  var
    i, j: integer;
  begin { reduceHisLiberties }
    playReason := 'reduceHisLiberties';
    reduceHisLiberties := true;
    sortLibs;
    for i := 1 to maxGroupID do
      with gList[sGList[i]] do
        if (not isLive) and
           (libC > 2) and
           (ndbord[lx, ly] = -1) then
          begin
            spanGroup(lx, ly, pList);
            for j := 1 to pList.indx do
              with pList.p[j] do
                if legal[px, py] and
                   (connectMap[px, py] > 0) then
                  if safeMove(px, py) then
                    begin
                      x := px;
                      y := py;
                      exit(reduceHisLiberties);
                    end;
          end;
    reduceHisLiberties := false;
  end { reduceHisLiberties };

  {
    connects a group to the edge
  }
  function dropToEdge2(var x, y: integer): boolean;
  var
    i: integer;
  begin { dropToEdge2 }
    playReason := 'dropToEdge2';
    dropToEdge2 := true;
    for i := 1 to maxPoint - 1 do
      begin
        if legal[i, 0] then
          begin
            if (ndbord[i, 1] = 1) and
               ((ndbord[i - 1, 0] < 1) or
                (groupIDs[i - 1, 0] <> groupIDs[i, 1])) and
               ((ndbord[i + 1, 0] < 1) or
                (groupIDs[i + 1, 0] <> groupIDs[i, 1])) and
               ((ndbord[i - 1, 1] = -1) or
                (ndbord[i + 1, 1] = -1)) then
              begin
                x := i;
                y := 0;
                if safeMove(x, y) then
                  exit(dropToEdge2);
              end;
          end;
        if legal[0, i] then
          begin
            if (ndbord[1, i] = 1) and
               ((ndbord[0, i - 1] < 1) or
                (groupIDs[0, i - 1] <> groupIDs[1, i])) and
               ((ndbord[0, i + 1] < 1) or
                (groupIDs[0, i + 1] <> groupIDs[1, i])) and
               ((ndbord[1, i - 1] = -1) or
                (ndbord[1, i + 1] = -1)) then
              begin
                x := 0;
                y := i;
                if safeMove(x, y) then
                  exit(dropToEdge2);
              end;
          end;
        if legal[i, maxPoint] then
          begin
            if (ndbord[i, maxPoint - 1] = 1) and
               ((ndbord[i - 1, maxPoint] < 1) or
                (groupIDs[i - 1, maxPoint] <> groupIDs[i, maxPoint - 1])) and
               ((ndbord[i + 1, maxPoint] < 1) or
                (groupIDs[i + 1, maxPoint] <> groupIDs[i, maxPoint - 1])) and
               ((ndbord[i - 1, maxPoint - 1] = -1) or
                (ndbord[i + 1, maxPoint - 1] = -1)) then
              begin
                x := i;
                y := maxPoint;
                if safeMove(x, y) then
                  exit(dropToEdge2);
              end;
          end;
        if legal[maxPoint, i] then
          begin
            if (ndbord[maxPoint - 1, i] = 1) and
               ((ndbord[maxPoint, i - 1] < 1) or
                (groupIDs[maxPoint, i - 1] <> groupIDs[maxPoint - 1, i])) and
               ((ndbord[maxPoint, i + 1] < 1) or
                (groupIDs[maxPoint, i + 1] <> groupIDs[maxPoint - 1, i])) and
               ((ndbord[maxPoint - 1, i - 1] = -1) or
                (ndbord[maxPoint - 1, i + 1] = -1)) then
              begin
                x := maxPoint;
                y := i;
                if safeMove(x, y) then
                  exit(dropToEdge2);
              end;
          end;
      end;
    dropToEdge2 := false;
  end { dropToEdge2 };

begin { blek }
  saveState;                    { save state of the world }
  if takeCorner(x, y) then
    goto 1;
  if lookForSave(x, y) then
    goto 1;
  if lookForSaveN(x, y) then
    goto 1;
  if extend(x, y) then         { check for possible 3-line extentions }
    goto 1;
  if lookForKill(x, y) then
    goto 1;
  if doubleAtari(x, y) then
    goto 1;
  if lookForAttack(x, y) then
    goto 1;
  if threaten(x, y) then
    goto 1;
  if extend2(x, y) then
    goto 1;
  if connectCut(x, y) then
    goto 1;
  if blockCut(x, y) then
    goto 1;
  if cutHim(x, y) then
    goto 1;
  if extendWall(x, y) then
    goto 1;
  if findAttack2(x, y) then
    goto 1;
  if atariAnyway(x, y) then
    goto 1;
  if underCut(x, y) then
    goto 1;
  if dropToEdge(x, y) then
    goto 1;
  if pushWall(x, y) then
    goto 1;
  if reduceHisLiberties(x, y) then
    goto 1;
  if dropToEdge2(x, y) then
    goto 1;
  moveX := iNil; { pass }
  moveY := iNil;
  exit(blek);
1: { done }
  moveX := x;
  moveY := y;
end { blek };

procedure genBord(who: sType);
var
  i, j: integer;
  noMoves: boolean;
begin { genBord }
  utilPlayLevel := playLevel;
  showTrees := debug;
  depthLimit := 100;
  mySType := who;
  if playLevel < 2 then
    treeLibLim := 2
  else
    treeLibLim := 3;
  noMoves := true;
  for i := 0 to maxPoint do
    for j := 0 to maxPoint do
      if board[i, j].val = who then
        begin
          bord[i, j] := 1;
          legal[i, j] := false;
          noMoves := false;
        end
      else if board[i, j].val = empty then
        begin
          bord[i, j] := 0;
          legal[i, j] := true;
        end
      else
        begin
          bord[i, j] := -1;
          legal[i, j] := false;
          noMoves := false;
        end;
  if koX >= 0 then
    legal[koX, koY] := false;
  if noMoves then
    initState
  else
    genState;
end { genBord };

function playMove(who: sType; var xLoc, yLoc: integer): boolean;
var
  i, j: integer;
  noMoves: boolean;
begin { playMove }
  saveNLibs := playLevel > 2;
  genBord(who);
  blek(xLoc, yLoc);
  playMove := xLoc <> iNil;
end { playMove };

procedure showPlayState(who: sType);
var
  res: resres;
  shown: boolean;
  cx, cy: integer;

  handler outside;
  begin { outside }
    write(''); {control-G}
    if shown then
      refreshBoard;
    exit(showPlayState);
  end { outside };

  procedure showIntBord(ib: intBoard);
  var
    i, j: integer;
    s: string;
  begin { showIntBord }
    for i := 0 to maxPoint do
      for j := 0 to maxPoint do
        if ib[i, j] <> 0 then
          begin
            s := intToStr(ib[i, j]);
            putBString(i, j, s);
          end;
  end { showIntBord };

  procedure showGroupState(sn: integer);
  var
    g: integer;
    s: string;

    procedure span(x, y: integer);
    begin { span }
      markBoard[x, y] := marker;
      putBString(x, y, s);
      if (x > 0) and
         (groupIDs[x - 1, y] = g) and
         (markBoard[x - 1, y] <> marker) then
        span(x - 1, y);
      if (x < maxPoint) and
         (groupIDs[x + 1, y] = g) and
         (markBoard[x + 1, y] <> marker) then
        span(x + 1, y);
      if (y > 0) and
         (groupIDs[x, y - 1] = g) and
         (markBoard[x, y - 1] <> marker) then
        span(x, y - 1);
      if (y < maxPoint) and
         (groupIDs[x, y + 1] = g) and
         (markBoard[x, y + 1] <> marker) then
        span(x, y + 1);
    end { span };

  begin { showGroupState }
    marker := marker + 1;
    if marker = 0 then
      begin
        initArray(markBoard);
        marker := 1;
      end;
    if sn < 3 then
      s := '*';
    for g := 1 to maxGroupID do
      with gList[g] do
        begin
          case sn of
            1: { isLive }
              if isLive then
                span(lx, ly);
            2: { isDead }
              if isDead then
                span(lx, ly);
            3: { libertyCount }
              begin
                s := intToStr(libC);
                span(lx, ly);
              end;
          end; { case }
        end;
  end { showGroupState };

begin { showPlayState }
  genBord(who);
  shown := false;
  cx := tabRelX;
  cy := tabRelY;
  repeat
    menu(stateMenu, false, 1, 11, cx, cy, -1, res);
    if shown then
      refreshBoard;
    case res^.indices[1] of
      1: { bord }
        showIntBord(bord);
      2: { ndBord }
        showIntBord(ndBord);
      3: { kleim }
        showIntBord(kleim);
      4: { sGroups }
        showIntBord(sGroups);
      5: { groupIDs }
        showIntBord(groupIDs);
      6: { connectMap }
        showIntBord(connectMap);
      7: { protPoints }
        showIntBord(protPoints);
      8: { isLive }
        showGroupState(1);
      9: { isDead }
        showGroupState(2);
      10: { libC }
        showGroupState(3);
      11: { done }
        exit(showPlayState);
    end; { case }
    shown := true;
    destroyRes(res);
  until false;
end { showPlayState };

procedure initGoPlayer;
begin { initGoPlayer }
  initGPUtils;
  maxPlayLevel := 7;
  allocNameDesc(11, 0, stateMenu);
  with stateMenu^ do
    begin
      header := 'State to Display?';
{$R-}
      commands[1] := 'Bord';
      commands[2] := 'NdBord';
      commands[3] := 'Influence';
      commands[4] := 'Space Groups';
      commands[5] := 'Group IDs';
      commands[6] := 'Connect Map';
      commands[7] := 'Protected Points';
      commands[8] := 'Live Groups';
      commands[9] := 'Dead Groups';
      commands[10] := 'Liberty Counts';
      commands[11] := 'Done';
{$R=}
    end;
end. { initGoPlayer }
SHAR_EOF
fi
if test -f 'goTree.pas'
then
    echo shar: "will not over-write existing file 'goTree.pas'"
else
cat << \SHAR_EOF > 'goTree.pas'
{---------------------------------------------------------------}
{ GoTree.Pas                                                    }
{                                                               }
{ Go Game Tree Manager                                          }
{ Copyright (c) 1982 by Three Rivers Computer Corp.             }
{                                                               }
{ Written: June 3, 1982 by Stoney Ballard                       }
{ Edit History:                                                 }
{    June  3, 1982  Started                                     }
{    June  4, 1982  Add dead group removal                      }
{    June 10, 1982  Use new go file manager                     }
{    Nov   9, 1982  Extracted from GO.PAS                       }
{    Nov  15, 1982  Added tag and comment deletion              }
{    Jan   5, 1983  Increased segment max sizes                 }
{    Jan   7, 1983  Changed File Format to have global comment  }
{---------------------------------------------------------------}

module goTree;

exports

imports goCom from goCom;
imports getTimeStamp from getTimeStamp;

type
  pMRec = ^moveRec;

  tagStr = string[maxTagLen];
  tagPtr = ^tagRec;
  tagRec = record
             mPtr: pMRec;
             nextTag: tagPtr;
             sTag: tagStr;
           end;

  mType = (header, move, remove, hcPlay, pass);
  moveRec = packed record
              mark: boolean;
              flink: pMRec;
              case id: mType of
                header:
                  (lastMove: pMRec;
                   freePool: pMRec;
                   lastTag: tagPtr;
                   nextMRec: integer;
                   nextMBlock: integer;
                   nextTRec: integer;
                   nextTBlock: integer;
                   nextCIdx: integer;
                   nextCBlock: integer;
                   freeTags: tagPtr);
                hcPlay, move, remove, pass:
                  (blink: pMRec;
                   slink: pMRec;
                   tag: tagPtr;
                   who: sType;
                   moveN: integer;
                   cmtBase: integer;
                   cmtLen: integer;
                   case {id:} mType of
                     hcPlay:
                       (hcNum: integer);
                     move, remove:
                       (mx: integer;
                        my: integer;
                        ox: integer;
                        oy: integer;
                        kx: integer;
                        ky: integer) )
            end;

  baseBlock = packed record
                case boolean of
                  false:
                    (padding: array[1..512] of char);
                  true:
                    (randBool: boolean;
                     oldTest: pointer;
                     fileVersion: integer;
                     created: timeStamp;
                     rootComment: string[127])
              end;

  pBaseBlock = ^baseBlock;

var
  treeRoot: pMRec;
  stepTag: tagPtr;
  hdrBlock: pBaseBlock;

exception goFNF;
exception badGoWrite;
exception badFileVersion;

procedure initGoTree;
procedure makeGoTree;
procedure readTree(nam: string);
procedure writeTree(nam: string; lm: pMRec);
function newMove(cm: pMRec): pMRec;
function delBranch(pm: pMRec): pMRec;
function hasAlts(pm: pMRec): boolean;
function isBranch(pm: pMRec): boolean;
function hasBranch(pm: pMRec): boolean;
function mergeMove(cm: pMRec): pMRec;
procedure tagMove(cm: pMRec; ts: tagStr);
function tagExists(ts: tagStr): boolean;
procedure commentMove(cm: pMRec; cs: string);
function getComment(cm: pMRec; var cs: string): boolean;
function getTag(cm: pMRec; var ts: string): boolean;
procedure delTag(tp: tagPtr);
procedure getFNameString(var fs: string);

private

imports fileSystem from fileSystem;
imports memory from memory;
imports perq_string from perq_string;
imports clock from clock;

const
  curFileVersion = 1;
  minTreeSize = 20;
  minTagSize = 4;
  minCmtSize = 4;
  maxTreeSize = 255;
  maxTagSize = 64;
  maxCmtSize = 128;
  treeSegInc = 8;
  tagSegInc = 4;
  cmtSegInc = 4;

type
  caType = packed array[0..1] of char;
  pCmtArray = ^caType;

var
  mFID: FileID;
  treeSeg, tagSeg, cmtSeg: integer;
  trSegSize, tagSegSize, cmtSegSize: integer;
  cmtArray: pCmtArray;
  cmtCmpArray: array[1..1024] of pMRec;

procedure getFNameString(var fs: string);
var
  ts: string;
begin  { getFNameString }
  fs := gameFName;
  if fs <> '' then
    begin
      stampToString(hdrBlock^.created, ts);
      fs := concat(fs, '  ');
      fs := concat(fs, ts);
    end;
end { getFNameString };

function isBranch(pm: pMRec): boolean;
begin { isBranch }
  repeat
    if pm = treeRoot then
      begin
        isBranch := false;
        exit(isBranch);
      end;
    pm := pm^.blink;
  until pm^.flink^.slink <> nil;
  isBranch := true;
end { isBranch };

function hasBranch(pm: pMRec): boolean;
begin { hasBranch }
  while pm^.flink <> nil do
    if pm^.flink^.slink <> nil then
      begin
        hasBranch := true;
        exit(hasBranch);
      end
    else
      pm := pm^.flink;
  hasBranch := false;
end { hasBranch };

procedure initSegs(trSize, tagSize, cmtSize: integer);
begin { initSegs }
  if treeSeg <> -1 then
    begin
      changeSize(treeSeg, trSize);
      changeSize(tagSeg, tagSize);
      changeSize(cmtSeg, cmtSize);
    end
  else
    begin
      createSegment(treeSeg, trSize, treeSegInc, maxTreeSize);
      createSegment(tagSeg, tagSize, tagSegInc, maxTagSize);
      createSegment(cmtSeg, cmtSize, cmtSegInc, maxCmtSize);
    end;
  trSegSize := trSize;
  tagSegSize := tagSize;
  cmtSegSize := cmtSize;
end { initSegs };

procedure initHdrBlock;
begin { initHdrBlock }
  with hdrBlock^ do
    begin
      oldTest := nil;
      fileVersion := curFileVersion;
      getTStamp(created);
      rootComment := '';
    end;
end { initHdrBlock };

procedure makeGoTree;
begin { makeGoTree }
  initSegs(minTreeSize, minTagSize, minCmtSize);
  initHdrBlock;
  treeRoot := makePtr(treeSeg, 0, pMRec);
  with treeRoot^ do
    begin
      id := header;
      freePool := nil;
      flink := nil;
      lastTag := nil;
      nextMRec := wordSize(moveRec);
      nextMBlock := minTreeSize * 256;
      nextTRec := 0;
      nextTBlock := minTagSize * 256;
      nextCIdx := 0;
      nextCBlock := minCmtSize * 512;
      freeTags := nil;
    end;
  cmtArray := makePtr(cmtSeg, 0, pCmtArray);
  stepTag := nil;
end { makeGoTree };

procedure readTree(nam: string);
type
   ptrHack = record
               case integer of
                 0: (p: pMRec);
                 1: (pt: tagPtr);
                 2: (po: integer;
                     ps: integer);
             end;
var
  size, gbg, i, b: integer;
  pd: pDirBlk;
  ph: ptrHack;
  pm: pMRec;
  tm: tagPtr;
  mBlks, tBlks, cBlks: integer;
begin { readTree }
  initSegs(minTreeSize, minTagSize, minCmtSize);
  mFID := FSLookup(nam, size, gbg);
  if mFID = 0 then
    raise goFNF;
  FSBlkRead(mFID, 0, recast(hdrBlock, pDirBlk));
  if hdrBlock^.oldTest <> nil then
    begin
      initHdrBlock;
      b := 0;
    end
  else if hdrBlock^.fileVersion <> curFileVersion then
    begin
      makeGoTree;
      raise badFileVersion;
    end
  else
    b := 1;
  pd := makePtr(treeSeg, 0, pDirBlk);
  FSBlkRead(mFID, b, pd);
  b := b + 1;
  treeRoot := makePtr(treeSeg, 0, pMRec);
  with treeRoot^ do
    begin
      mBlks := nextMBlock div 256;
      tBlks := nextTBlock div 256;
      cBlks := nextCBlock div 512;
    end;
  initSegs(mBlks, tBlks, cBlks);
  for i := 1 to mBlks - 1 do
    begin
      pd := makePtr(treeSeg, i * 256, pDirBlk);
      FSBlkRead(mFID, b, pd);
      b := b + 1;
    end;
  for i := 0 to tBlks - 1 do
    begin
      pd := makePtr(tagSeg, i * 256, pDirBlk);
      FSBlkRead(mFID, b, pd);
      b := b + 1;
    end;
  for i := 0 to cBlks - 1 do
    begin
      pd := makePtr(cmtSeg, i * 256, pDirBlk);
      FSBlkRead(mFID, b, pd);
      b := b + 1;
    end;
  with treeRoot^ do
    begin
      if freePool <> nil then
        begin
          ph.p := freePool;
          ph.ps := treeSeg;
          freePool := ph.p;
        end;
      if flink <> nil then
        begin
          ph.p := flink;
          ph.ps := treeSeg;
          flink := ph.p;
        end;
      if lastMove <> nil then
        begin
          ph.p := lastMove;
          ph.ps := treeSeg;
          lastMove := ph.p;
        end;
      if lastTag <> nil then
        begin
          ph.pt := lastTag;
          ph.ps := tagSeg;
          lastTag := ph.pt;
        end;
      if freeTags <> nil then
        begin
          ph.pt := freeTags;
          ph.ps := tagSeg;
          freeTags := ph.pt;
        end;
    end;
  i := wordSize(moveRec);
  while i < treeRoot^.nextMRec do
    begin
      pm := makePtr(treeSeg, i, pMRec);
      with pm^ do
        begin
          if flink <> nil then
            begin
              ph.p := flink;
              ph.ps := treeSeg;
              flink := ph.p;
            end;
          if blink <> nil then
            begin
              ph.p := blink;
              ph.ps := treeSeg;
              blink := ph.p;
            end;
          if slink <> nil then
            begin
              ph.p := slink;
              ph.ps := treeSeg;
              slink := ph.p;
            end;
          if tag <> nil then
            begin
              ph.pt := tag;
              ph.ps := tagSeg;
              tag := ph.pt;
            end;
        end;
      i := i + wordSize(moveRec);
    end;
  i := 0;
  while i < treeRoot^.nextTRec do
    begin
      tm := makePtr(tagSeg, i, tagPtr);
      with tm^ do
        begin
          if mPtr <> nil then
            begin
              ph.p := mPtr;
              ph.ps := treeSeg;
              mPtr := ph.p;
            end;
          if nextTag <> nil then
            begin
              ph.pt := nextTag;
              ph.ps := tagSeg;
              nextTag := ph.pt;
            end;
        end;
      i := i + wordSize(tagRec);
    end;
  stepTag := nil;
end { readTree };

procedure writeTree(nam: string; lm: pMRec);
var
  pd: pDirBlk;
  treeBlks, tagBlks, cmtBlks: integer;
  b, i: integer;

  procedure compressCmts;
  var
    numCmts: integer;
    cp: pMRec;

    procedure spanComments(m: pMRec);
    begin { spanComments }
      while m <> nil do
        begin
          if m^.cmtLen > 0 then
            begin
              numCmts := numCmts + 1;
              cmtCmpArray[numCmts] := m;
            end;
          spanComments(m^.slink);
          m := m^.flink;
        end;
    end { spanComments };

    procedure sortComments;
    var
      i, j: integer;
      t: pMRec;
    begin { sortComments }
      for i := 1 to numCmts - 1 do
        for j := i + 1 to numCmts do
          if cmtCmpArray[i]^.cmtBase > cmtCmpArray[j]^.cmtBase then
            begin
              t := cmtCmpArray[i];
              cmtCmpArray[i] := cmtCmpArray[j];
              cmtCmpArray[j] := t;
            end;
    end { sortComments };

    procedure squeezeComments;
    var
      i, j, cgi, lastCB: integer;
      mp: pMRec;
    begin { squeezeComments }
      lastCB := 0;
      for i := 1 to numCmts do
        begin
          if cmtCmpArray[i]^.cmtBase > lastCB then
            begin
              cgi := cmtCmpArray[i]^.cmtBase;
              for j := 0 to cmtCmpArray[i]^.cmtLen - 1 do
                begin
    {$R-}
                  cmtArray^[lastCB + j] := cmtArray^[cgi + j];
    {$R=}
                end;
              cmtCmpArray[i]^.cmtBase := lastCB;
            end;
          lastCB := cmtCmpArray[i]^.cmtBase + cmtCmpArray[i]^.cmtLen;
        end;
      treeRoot^.nextCIdx := lastCB;
    end { squeezeComments };

  begin { compressCmts }
    numCmts := 0;
    cp := treeRoot^.flink;
    if cp <> nil then
      begin
        spanComments(cp);
        sortComments;
        squeezeComments;
      end;
  end { compressCmts };

begin { writeTree }
  mFID := FSEnter(nam);
  if mFID = 0 then
    raise badGoWrite
  else
    begin
      compressCmts;
      with treeRoot^ do
        begin
          lastMove := lm;
          treeBlks := nextMBlock div 256;
          tagBlks := nextTBlock div 256;
          cmtBlks := nextCBlock div 512;
        end;
      FSBlkWrite(mFID, 0, recast(hdrBlock, pDirBlk));
      b := 1;
      for i := 0 to treeBlks - 1 do
        begin
          pd := makePtr(treeSeg, i * 256, pDirBlk);
          FSBlkWrite(mFID, b, pd);
          b := b + 1;
        end;
      for i := 0 to tagBlks - 1 do
        begin
          pd := makePtr(tagSeg, i * 256, pDirBlk);
          FSBlkWrite(mFID, b, pd);
          b := b + 1;
        end;
      for i := 0 to cmtBlks - 1 do
        begin
          pd := makePtr(cmtSeg, i * 256, pDirBlk);
          FSBlkWrite(mFID, b, pd);
          b := b + 1;
        end;
      FSClose(mFID, treeBlks + tagBlks + cmtBlks, 4096);
    end;
end { writeTree };

function newMove(cm: pMRec): pMRec;
var
  pm: pMRec;
begin { newMove }
  with treeRoot^ do
    if freePool <> nil then
      begin
        pm := freePool;
        freePool := pm^.flink;
      end
    else
      begin
        if nextMRec + wordSize(moveRec) > nextMBlock then
          begin
            trSegSize := trSegSize + treeSegInc;
            changeSize(treeSeg, trSegSize);
            nextMBlock := nextMBlock + (treeSegInc * 256);
          end;
        pm := makePtr(treeSeg, nextMRec, pMRec);
        nextMRec := nextMRec + wordSize(moveRec);
      end;
  with pm^ do
    begin
      flink := nil;
      blink := cm;
      slink := nil;
      tag := nil;
      cmtLen := 0;
    end;
  if cm^.flink <> nil then
    pm^.slink := cm^.flink;
  cm^.flink := pm;
  newMove := pm;
end { newMove };

procedure tagMove(cm: pMRec; ts: tagStr);
var
  tp: tagPtr;
begin { tagMove }
  if cm^.tag <> nil then
    cm^.tag^.sTag := ts
  else
    with treeRoot^ do
      begin
        if freeTags <> nil then
          begin
            tp := freeTags;
            freeTags := tp^.nextTag;
          end
        else
          begin
            if nextTRec + wordSize(tagRec) > nextTBlock then
              begin
                tagSegSize := tagSegSize + tagSegInc;
                changeSize(tagSeg, tagSegSize);
                nextTBlock := nextTBlock + (tagSegInc * 256);
              end;
            tp := makePtr(tagSeg, nextTRec, tagPtr);
            nextTRec := nextTRec + wordSize(tagRec);
          end;
        cm^.tag := tp;
        with tp^ do
          begin
            mPtr := cm;
            nextTag := lastTag;
            sTag := ts;
          end;
        lastTag := tp;
      end;
  treeDirty := true;
end { tagMove };

function tagExists(ts: tagStr): boolean;
var
  tp: tagPtr;

  function upCmp(s1, s2: pString): boolean;
  begin { upCmp }
    convUpper(s1);
    convUpper(s2);
    upCmp := s1 = s2;
  end { upCmp };

begin { tagExists }
  tp := treeRoot^.lastTag;
  while tp <> nil do
    if upCmp(tp^.sTag, ts) then
      begin
        tagExists := true;
        exit(tagExists);
      end
    else
      tp := tp^.nextTag;
  tagExists := false;
end { tagExists };

procedure commentMove(cm: pMRec; cs: string);
var
  sl, i: integer;
begin { commentMove }
  if cm = treeRoot then
    hdrBlock^.rootComment := cs
  else
    begin
      sl := length(cs);
      with cm^ do
        begin
          cmtLen := sl;
          if sl > 0 then
            begin
              cmtBase := treeRoot^.nextCIdx;
              treeRoot^.nextCIdx := cmtBase + sl;
              if cmtBase + cmtLen > treeRoot^.nextCBlock then
                with treeRoot^ do
                  begin
                    cmtSegSize := cmtSegSize + cmtSegInc;
                    changeSize(cmtSeg, cmtSegSize);
                    nextCBlock := nextCBlock + (cmtSegInc * 512);
                  end;
              for i := 0 to sl - 1 do
                begin
{$R-}
                  cmtArray^[cmtBase + i] := cs[i + 1];
{$R=}
                end;
            end;
        end;
    end;
  treeDirty := true;
end { commentMove };

function getComment(cm: pMRec; var cs: string): boolean;
var
  i: integer;
begin { getComment }
  if cm = treeRoot then
    begin
      cs := hdrBlock^.rootComment;
      getComment := cs <> '';
    end
  else if cm^.cmtLen = 0 then
    getComment := false
  else
    with cm^ do
      begin
        getComment := true;
        adjust(cs, cmtLen);
        for i := 1 to cmtLen do
          begin
{$R-}
            cs[i] := cmtArray^[cmtBase + i - 1];
{$R=}
          end;
      end;
end { getComment };

function getTag(cm: pMRec; var ts: string): boolean;
begin { getTag }
  if cm = treeRoot then
    getTag := false
  else if cm^.tag = nil then
    getTag := false
  else
    begin
      ts := cm^.tag^.sTag;
      getTag := true;
    end;
end { getTag };

procedure delTag(tp: tagPtr);
var
  ttp: tagPtr;
begin { delTag }
  tp^.mPtr^.tag := nil;
  tp^.mPtr := nil;
  if stepTag = tp then
    stepTag := nil;
  ttp := treeRoot^.lastTag;
  if ttp = tp then
    treeRoot^.lastTag := tp^.nextTag
  else
    begin
      while ttp^.nextTag <> tp do
        ttp := ttp^.nextTag;
      ttp^.nextTag := tp^.nextTag;
    end;
  tp^.nextTag := treeRoot^.freeTags;
  treeRoot^.freeTags := tp;
end { delTag };

function delBranch(pm: pMRec): pMRec;
var
  sm: pMRec;

  procedure recDel(m: pMRec);
  var
    tp: tagPtr;
  begin { recDel }
    if m <> nil then
      begin
        recDel(m^.slink);
        recDel(m^.flink);
        m^.blink := nil;
        m^.slink := nil;
        m^.flink := treeRoot^.freePool;
        treeRoot^.freePool := m;
        if m^.tag <> nil then
          delTag(m^.tag);
      end;
  end { recDel };

begin { delBranch }
  if pm = treeRoot then
    exit(delBranch);
  while pm^.id = remove do
    pm := pm^.blink;
  if pm^.blink^.flink = pm then
    pm^.blink^.flink := pm^.slink
  else
    begin
      sm := pm^.blink^.flink;
      while sm^.slink <> pm do
        sm := sm^.slink;
      sm^.slink := pm^.slink;
    end;
  pm^.slink := nil;
  delBranch := pm^.blink;
  pm^.blink := nil;
  recDel(pm);
end { delBranch };

procedure delNode(pm: pMRec);
var
  sm: pMRec;
begin { delNode }
  if pm = treeRoot then
    exit(delNode);
  if pm^.blink^.flink = pm then
    pm^.blink^.flink := pm^.slink
  else
    begin
      sm := pm^.blink^.flink;
      while sm^.slink <> pm do
        sm := sm^.slink;
      sm^.slink := pm^.slink;
    end;
  pm^.blink := nil;
  pm^.slink := nil;
  pm^.flink := treeRoot^.freePool;
  treeRoot^.freePool := pm;
end { delNode };

function mergeMove(cm: pMRec): pMRec;
var
  tm: pMRec;
begin { mergeMove }
  tm := cm^.blink^.flink;
  mergeMove := cm;
  while tm <> nil do
    begin
      if tm <> cm then
        with tm^ do
          if id = cm^.id then
            if id = hcPlay then
              begin
                mergeMove := tm;
                delNode(cm);
                exit(mergeMove);
              end
            else if id = pass then
              begin
                if who = cm^.who then
                  begin
                    mergeMove := tm;
                    delNode(cm);
                    exit(mergeMove);
                  end;
              end
            else if (mx = cm^.mx) and
               (my = cm^.my) and
               (who = cm^.who) then
              begin
                mergeMove := tm;
                delNode(cm);
                exit(mergeMove);
              end;
      tm := tm^.slink;
    end;
  treeDirty := true;
end { mergeMove };

function hasAlts(pm: pMRec): boolean;
begin { hasAlts }
  while pm^.id = remove do
    pm := pm^.blink;
  hasAlts := pm^.blink^.flink^.slink <> nil;
end { hasAlts };

procedure initGoTree;
begin { initGoTree }
  treeSeg := -1;
  new(0, 256, hdrBlock);
end. { initGoTree }
SHAR_EOF
fi
exit 0
#    End of shell archive